(Solved) – VBA Code to print automatically an attachment from an Outlook Email that is inside another email as an attachment

  • by
(solved)-–-vba-code-to-print-automatically-an-attachment-from-an-outlook-email-that-is-inside-another-email-as-an-attachment

Sometimes we receive Outlook email messages with another email message as an attachment. The attachment email itself has attachments, usually PDF files. I would like to automate the printing of the attachments which are attached to the second email message using VBA. I am not very experienced in VBA, but what I am trying to do seems to be a variation of the VBA code which shareedit and brettdj posted in 2011 concerning VBA code to save an attachment from an Outlook email that was inside another email as an attachment.

Here is the code which was posted to stackoverflow in 2011 to save attachments:

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:test"

    'path for creating attachment msg file for stripping
    strFilePath = "C:temp"
    strTmpMsg = "KillMe.msg"

    'My testing done in Outlok using a "temp" folder underneath Inbox
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olFolder = olFolder.Folders("Temp")
    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
                sSavePathFS = fsSaveFolder & 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

Leave a Reply

Your email address will not be published. Required fields are marked *