Drukowanie zaznaczonych wiadomości oraz plików PDF załączonych do tych wiadomości

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

Sub drukuj()
    'Dla wszystkich plików PDF
    Call PrintPDFAttachments4SelectionEmail()
    'Dla tylko tych które w nazwie zawierają słowo "faktura"
    'Call PrintPDFAttachments4SelectionEmail("faktura")

    For Each oMail In Application.ActiveExplorer.Selection
        oMail.PrintOut() 'Można zwielokrotnić drukowanie powielając tą linię
    Next
End Sub

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

    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
blad:
    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 blad
    FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
    Exit Function
blad:
    FileExists = False
End Function