Impression Pièces Jointes

 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpszOp As String, _
    ByVal lpszFile As String, ByVal lpszParams As String, _
    ByVal lpszDir As String, ByVal fsShowCmd As Long) As Long
 
'la macro d'impression, chems= chemin complet de la piece jointe
Sub printPDF(chems)
    Dim Res As Long
    Dim chemin_de_MaPj As String
    chemin_de_MaPj = chems
    Res = ShellExecute(0, "print", chemin_de_MaPj, "", "", 0)
End Sub
 
Sub PrintAllPDF()
 
    Dim strFileName As String
    Dim strPath As String
 
    strPath = "c:\test\"
    strFileName = Dir(strPath + "*.pdf", vbNormal)
    Do While strFileName <> ""
 
        LeFichier = strPath + strFileName
        printPDF (LeFichier)
        strFileName = Dir
    Loop
 
End Sub
 
Sub detache_PJ()
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim LesMails As Object
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
             Dim pj As Attachment
            For Each pj In LeMail.Attachments
                If Right(UCase(pj.FileName), 4) = ".PDF" Then
                    LeFichier = "c:\test\" & pj.FileName
                    pj.SaveAsFile (LeFichier)
 
                End If
            Next pj
    Next LeMail
    Set LesMails = Nothing
End Sub
 
Sub detache_et_imprime()
    
    Call detache_PJ
    Call PrintAllPDF
 
    MsgBox "Opération terminée, cliquez sur OK pour finir."
    Kill "C:\test\*.pdf"
 
End Sub