PDF bijlage automatisch printen vanuit Outlook

Sub BijlagenOpslaanPrinten()

' Deze macro controleert een voorgedefinieerde subfolder in Outlook op Attachments.
' De opgeslagen bestanden worden afgedrukt op de standaardprinter.

' Afvangen van fouten
On Error GoTo SaveAttachmentsToFolder_err

' Variabelen declareren
    Pad = InputBox("Typ de naam van de map:", "Mapnaam", "H:\Bijlagen\")
    Pad = "H:\Functioneel Beheer\Processen\"
    Set NS = GetNamespace("MAPI")
    ' Of typ een naam voor het selecteren van een vaste folder...
    ''Set Folder = Inbox.Folders("Helpdesk") 'TYP HIER DE NAAM VAN DE Folder IN OUTLOOK.
    Set Folder = NS.GetDefaultFolder(olFolderInbox)     ' Met Early Binding
    Set Folder = NS.GetDefaultFolder(9)                 ' Met Late Binding
    ' Gebruik onderstaande routine om een folder te selecteren...
    Set Folder = NS.PickFolder

    i = 0
    ' Controleer de Folder op Attachments en sluit af als er niets gevonden wordt.
    If Folder.Items.Count = 0 Then
        MsgBox "Er zijn geen berichten met Bijlagen in de folder " & Folder.Name & ".", vbInformation, "Niets gevonden"
        Exit Sub
    End If
    
    ' Controleer elk bericht op Attachments
    For Each item In Folder.Items
        For Each atmt In item.Attachments
            ' Controleer de filenaam van elke Attachment and sla die met "pdf" extensie op in voorgedefineerde map.
            If Not Right(atmt.FileName, 3) = "pdf" Then  '' Or Right(atmt.FileName, 3) = "xls" Then
                FileName = Pad & atmt.FileName
                atmt.SaveAsFile FileName
                i = i + 1
                'document printen
                Shell """C:\Program Files\Adobe\Reader 9.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
            End If
        Next atmt
    Next item
    
    ' Laat een totaal van berichten zien
    If i > 0 Then
        varResponse = MsgBox("Er zijn " & i & " bijlagen." & vbCrLf _
            & "Ze zijn opgeslagen in " & Pad & "." & vbCrLf & vbCrLf _
            & "Wil je ze nu bekijken?", vbQuestion + vbYesNo, "Klaar!")
        ' Open Windows Explorer om de opgeslagen bestanden te laten zien.
        If varResponse = vbYes Then
            Shell "Explorer.exe /e," & Pad, vbNormalFocus
        End If
    Else
        MsgBox "Er zijn geen bijlagen gevonden in de mails.", vbInformation, "Finished!"
    End If
    
    'Tel het aantal mailtjes in de folder
    iCount = Folder.Items.Count
    varResponse = MsgBox("Wil je de " & iCount & " mailtjes nu wissen?", vbQuestion + vbYesNo, "Finished!")
    ' Alle mailtjes wissen.
    If varResponse = vbYes Then
        For i = Folder.Items.Count To 1 Step -1
            Folder.Items.item(i).Delete
            numDeleted = iCount - Folder.Items.Count
            If numDeleted Mod 100 = 0 Then
                MsgBox ("Deleted " & numDeleted & " items of " & iCount & ".")
            End If
        Next
        MsgBox ("Successfully deleted " & numDeleted & " items.")
    End If
    
    ' Maak het geheugen leeg
SaveAttachmentsToFolder_exit:
    Set atmt = Nothing
    Set item = Nothing
    Set NS = Nothing
    Exit Sub
    
    ' Foutverwerking
SaveAttachmentsToFolder_err:
    MsgBox "Er is een fout opgetreden." _
    & vbCrLf & "Rapporteer de volgende fout." _
    & vbCrLf & "Macro Naam: BijlagenOpslaanPrinten()" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume Next

End Sub