Save Outlook Attachments

Alt+F11 and paste following code in Outlook vba editor in a new module.

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oOutlookAttachment As Outlook.Attachment
    Dim sSaveAttachmentsFolder As String
    sSaveAttachmentsFolder = "C:\Users\dakm\Desktop\attachments\"
    ' Not to save following files.
    arrIgnoreFiles = Array("graycol.gif", "image001.gif")

    For Each oOutlookAttachment In MItem.Attachments
        If IsInArray(oOutlookAttachment.DisplayName, arrIgnoreFiles) = False Then
            oOutlookAttachment.SaveAsFile sSaveAttachmentsFolder & oOutlookAttachment.DisplayName
        End If
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = UBound(Filter(arr, stringToBeFound)) > -1
End Function

Leave a Comment

Your email address will not be published.