Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save ezhov-da/1c29640ac8376e6d8aec641a69420475 to your computer and use it in GitHub Desktop.
Save ezhov-da/1c29640ac8376e6d8aec641a69420475 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment