How to print message together with the PDF document attached to it?

More and more often e-mail messages are sent with PDF documents attached. In most businesses they are required to be printed and included in the traditional paper-based archive of documents (e.g. in the accounting department). How to quickly print such message?

In MS Outlook when you select the print option it will do that only for the message body. But what about attachments? Normally user needs to open each of them and print separately.

The macro code below helps to automate these activities, even without opening the email - just select the message from the list in Outlook.

Option Explicit On
Dim oMail As MailItem, item As Object
Dim oAtmt As Attachment, FileName$, x&

Sub drukuj()
    'For all PDF files
    Call PrintPDFAttachments4SelectionEmail()
    'For these with the „Invoice” word in their name
    'Call PrintPDFAttachments4SelectionEmail("invoice")

    For Each oMail In Application.ActiveExplorer.Selection
        oMail.PrintOut() 'You can multiply the print multiplying this line
    Next
End Sub

Private Sub PrintPDFAttachments4SelectionEmail(Optional AttName$)
    If FileExists("C:\Temp") = False Then MkDir("C:\Temp")
	On Error GoTo error   

    For Each item In Application.ActiveExplorer.Selection
        If item.Class = 43 Then
            oMail = item
            If oMail.Attachments.Count > 0 Then
                For Each oAtmt In oMail.Attachments
                    If Len(AttName) = 0 Then
ones:
                        FileName = "C:\Temp\" & oAtmt.FileName
                        If FileExists(FileName) = True Then Kill(FileName) 'lub odpytanie komend± MSGBOX z parametrem.
                        oAtmt.SaveAsFile(FileName)
                        If Right$(UCase(oAtmt.FileName), 3) = "PDF" Then
                            Shell("""c:\Program Files (x86)\Adobe\Reader 9.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide)
                        End If
                    Else
                        If InStr(1, UCase(oAtmt.FileName), UCase(AttName)) > 0 Then GoTo ones
                    End If
                Next oAtmt
            End If
        End If
    Next item
    Exit Sub
			error:
    MsgBox(Err.Number & vbCr & Err.Description, vbExclamation, "O'Shon from VBATools.pl")
End Sub
Private Function FileExists(ByVal FilePath As String) As Boolean
			On Error GoTo error
    FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
    Exit Function
			error:
    FileExists = False
End Function

Because the Acrobat Reader program might be installed in the different location on your hard drive you need to set a correct path to the acrord32.exe, file in the macro code.
 
In case of problems with the PDF print itself (e.g. special characters displayed incorrectly) try to set the printer to Print as image in its advanced options.