vba-Загрузка вложений выделенных писем в Outlook-DownloadAttachmentsOfSelectedEmails.vb

Sub DownloadAttachmentsOfSelectedEmails()
    Const XLSX_EXTENSION_PATTERN As String = "xlsx" 'расширение для вложения
    Const XLS_EXTENSION_PATTERN As String = "xls" 'расширение для вложения
    Const PATH As String = "C:\Users\DEzhov\Attachments\" 'папка для сохранения
 
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim mySender As Outlook.AddressEntry
    Dim oMail As Outlook.MailItem
 
    Dim Atts As Attachments
    Dim Att As Attachment
 
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
 
    Dim countDownloadAttachments As Integer
    Dim countEmails As Integer
    
    countEmails = myOlSel.Count
 
    Dim x As Long
    For x = 1 To countEmails
        If myOlSel.Item(x).Class = OlObjectClass.olMail Then
            Set oMail = myOlSel.Item(x)
        End If
 
        Set Atts = oMail.Attachments
        
        Dim subject As String: subject = oMail.subject
               
        If Atts.Count > 0 Then
            For Each Att In Atts
                Dim fileName As String
                fileName = LCase(Att.fileName)
                
                Dim xlsxFileExtension As String
                xlsxFileExtension = Right(fileName, Len(XLSX_EXTENSION_PATTERN))
                
                Dim xlsFileExtension As String
                xlsFileExtension = Right(fileName, Len(XLS_EXTENSION_PATTERN))
            
                If xlsxFileExtension = XLSX_EXTENSION_PATTERN Or xlsFileExtension = XLS_EXTENSION_PATTERN Then
                    Dim strPath As String
                    strPath = PATH
                    
                    subject = Trim(subject)
                    subject = Replace(subject, "<", "")
                    subject = Replace(subject, ">", "")
                    subject = Replace(subject, ":", "")
                    subject = Replace(subject, """", "")
                    subject = Replace(subject, "/", "")
                    subject = Replace(subject, "\", "")
                    subject = Replace(subject, "|", "")
                    subject = Replace(subject, "?", "")
                    subject = Replace(subject, "*", "")
                    subject = Replace(subject, vbTab, "")
                    
                    Dim strName As String
                    strName = subject & "-" & countDownloadAttachments & "-" & Att.fileName
                    
                    Att.SaveAsFile strPath & strName
                                        
                    countDownloadAttachments = countDownloadAttachments + 1
                    Debug.Print "Mail subject: " & oMail.subject & ", " & "File: " & strPath & Att.fileName
                End If
            Next
        End If
    Next x
    
    MsgBox ("Download '" & countDownloadAttachments & "' attachments from '" & countEmails & "' emails")
End Sub