Outlook Saving Attachment with Subject Name

Question

I have a Macro that saves all attachments from emails in my inbox to the directory specified. However, I would like to save the attachments with the email subject as the filename.

This is my first Macro and first time looking at VBA so any pointers are much appreciated.

Private Sub Outlook_VBA_Save_Attachment()
    ''Variable declarions
    Dim ns As NameSpace
    Dim inb As Folder
    Dim itm As MailItem
    Dim atch As Attachment

    ''Variables Initialization
    Set ns = Outlook.GetNamespace("MAPI")
    Set inb = ns.GetDefaultFolder(olFolderInbox)
    File_Path = "H:\Notes\"

    ''Loop Thru Each Mail Item
    For Each itm In inb.Items

    ''Loop Thru Each Attachment
        For Each atch In itm.Attachments
            If atch.Type = olByValue Then
               atch.SaveAsFile File_Path & atch.FileName
            End If
        Next atch
    Next itm

    '''''Notify the Termination of Process
    MsgBox "Attachments Extracted to: " & File_Path
End Sub

Brian M Stafford · Accepted Answer · 2017-07-13T14:30:06.663

3

All you need to do is change one line:

atch.SaveAsFile File_Path & itm.Subject

To include the original file extension, you can use the FileSystemObject to grab it. The modified code would be as follows:

Private Sub Outlook_VBA_Save_Attachment()
    ''Variable declarions
    Dim ns As Namespace
    Dim inb As Folder
    Dim itm As MailItem
    Dim atch As Attachment
    Dim fso As FileSystemObject

    ''Variables Initialization
    Set ns = Outlook.GetNamespace("MAPI")
    Set inb = ns.GetDefaultFolder(olFolderInbox)
    File_Path = "H:\Notes\"
    Set fso = New FileSystemObject

    ''Loop Thru Each Mail Item
    For Each itm In inb.Items

    ''Loop Thru Each Attachment
        For Each atch In itm.Attachments
            If atch.Type = olByValue Then
               atch.SaveAsFile File_Path & itm.Subject & "." & fso.GetExtensionName(atch.Filename)
            End If
        Next atch
    Next itm

    '''''Notify the Termination of Process
    MsgBox "Attachments Extracted to: " & File_Path
End Sub

This will require a Reference to Microsoft Scripting Runtime.

edited Jul 13 '17 at 14:30

answered Jul 13 '17 at 14:04

Brian M Stafford

8,483
2
16
25

That does work, so thank you, however it removes the file extension. Is there a way to fix that? – BrettJ Jul 13 '17 at 14:15
I modified the code sample to include the file extension. – Brian M Stafford Jul 13 '17 at 14:30
Beautiful! Thanks for the help. For future users this is how you enable reference to MS Scripting Runtime. https://stackoverflow.com/questions/3233203/how-do-i-use-filesystemobject-in-vba – BrettJ Jul 13 '17 at 14:42
3

Keep in mind that if there are multiple attachments, you will only get the last one since you always overwrite the attachments. A better solution would be to combine the subject and the attachment file name: atch.SaveAsFile File_Path & itm.Subject & " - " & atch.FileName,. You also need to make sure there are no invalid (for a file name) characters, such as ":". – Dmitry Streblechenko Jul 13 '17 at 20:48

Outlook Saving Attachment with Subject Name

1 Answers1