Sub PocketExtraction()
    Dim myApp           As Outlook.Application: Set myApp = CreateObject("Outlook.Application")
    Dim ns              As Outlook.NameSpace:   Set ns = myApp.GetNamespace("MAPI")
    Dim oFolder As Outlook.MAPIFolder
    Set oFolder = ns.Folders("your_addres@kubanpromstroy.ru").Folders("Входящие")
    Dim oItem          As Outlook.MailItem
    Dim oFile As Object
    Dim sFileName As String
    Dim sFullName As String
    
    For Each oItem In oFolder.Items
        For Each oFile In oItem.Attachments
            sFileName = oFile.FileName
            If LCase(Right(sFileName, 3)) = "pdf" Then
                sFullName = "C:\tmp\" & sFileName
                oFile.SaveAsFile sFullName
            End If
        Next
    Next
End Sub

"D:\pdf\"