Savings Attachments from an email that was sent as an Email (i.e. MSG)

Question

I receive a lot of emails which include .msg attachments. I usually have to manually open the email, then open the .msg attachment to get to the .pdf file which is attached. I often receive over 200 emails in this format and it takes some time to get all the PDF files printed. I managed to put together the below code (With a lot of help from the online forums)

Sub SaveOlAttachments()

Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim msg2 As Outlook.MailItem
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim strTmpMsg As String
Dim fsSaveFolder As String

fsSaveFolder = "C:\Users\nicholson.a.9\Desktop\Invoices to Print\"

strFilePath = "C:\temp\"
strTmpMsg = "KillMe.msg"

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("MSG Attachments")
i = 0
If olFolder Is Nothing Then Exit Sub
For Each msg In olFolder.Items

    If msg.Attachments.Count > 0 Then
    While msg.Attachments.Count > 0
    bflag = False
        If Right$(msg.Attachments(1).FileName, 3) = "msg" Then
            bflag = True
            msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
            Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
        End If
        If bflag Then
        i = i + 1
            sSavePathFS = fsSaveFolder & "\" & i & " - " & msg2.Attachments(1).FileName
            msg2.Attachments(1).SaveAsFile sSavePathFS
            msg2.Delete
        Else
            sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName
            msg.Attachments(1).SaveAsFile sSavePathFS
        End If
        msg.Attachments(1).Delete
        Wend
        msg.Delete
    End If
Next
End Sub

The code works, and If I receive an email with msg attachments, I copy the email and paste it into the sub-folder beneath my Inbox, (MSG Attachments) then run the script. The problem I am having is when an attachment has the same name i.e. AT0001, the script will only extract one attachment and leave all the others. Can anyone help? Thanks

Dmitry Streblechenko Dmitry Streblechenko · Accepted Answer · 2013-05-17T16:32:49

You probably save all attachments, but the latest one wins and overwrites the older ones. You need to either check that the file already exists and use a unique file name, or save the attachment and process it before saving the next attachment.

Savings Attachments from an email that was sent as an Email (i.e. MSG)

1 Answers