Макрос для автоматического сохранения вложений из общего почтового ящика в Outlook

Sub saveAtt(mailitem As Outlook.mailitem)
 
'задаём переменные
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Variant
Dim olAtt As Outlook.Attachment
Dim olNS As Outlook.NameSpace
 
Set olNS = GetNamespace("MAPI")
 
'определяем почтовый ящик
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
 
'обращаемся поочерёдно к каждому письму в почтовом ящике
For Each olItem In olFolder.Items
 
    'проверяем отвечает ли тема условию, указанному в кавычках в строке ниже
    If mailitem.Subject Like "*Документация*" Then
        
        'если тема отвечает условию, обращаемся поочерёдно к каждому вложению в письме
        For Each olAtt In mailitem.attachments
        
            'проверяем отвечает ли имя вложения условию, указанному в кавычках в строке ниже
            If InStr(olAtt.FileName, "ПД") Then
            
                'если да, определяем папку сохранения вложения с данным имененем
                saveFolder = "C:\УССС\Документация по объектам производства работ"
                'и сохраняем вложение в данную папку
                olAtt.SaveAsFile saveFolder & "" & olAtt.FileName
            End If
        'переходим к следующему вложению и проверяем его на условие выше, пока вложения не закончатся
        Next olAtt
            
    End If
  
Next olItem
 
Set olFolder = Nothing
Set olNS = Nothing
 
End Sub