Publipostage par mail en pièce jointe en PDF

Sub Emailling_Pj_PDF()
    ' Objectif    : Générer un publipostage sous forme d'e-mail, le document étant en pièce jointe et en PDF.
    ' Utilisation : A partir du document principal de fusion (celui avec les champs de fusion),
    '               lancer la macro en ayant au préalable mis à jour les constantes du début du code.
    '               Choisir soit Display ou Send en bas du code (ajouter ou supprimer l'apostrophe).
    ' Auteur      : Arnaud (www.1forme.fr)
    ' Licence     : CC-BY-NC-SA (Vous pouvez diffuser/partager/modifier cette macro dans les même conditions,
    '                           seulement à titre personnel et citant l'auteur/site d'origine.

    ' Constantes à mettre à jour !
    ' ============================
    ' Modifier les valeurs à droite de l'égale (=), conserver les guillemets
    Const strChampNomFichier  As String = "NomPJ"      ' Champ donnant le nom du fichier(PJ)
    Const strChampMail_To     As String = "Mail"       ' Champ donnant le nom du destinataire
    Const strChampMail_CC     As String = ""           ' Champ donnant le nom du destinataire en copie ("" si non utilisée)
    Const strObjetMail        As String = "Invitation" ' Objet du mail
    Const strImportant        As String = "Non"        ' Marquer comme important (Oui ou Non)
    Const strAccReception     As String = "Non"        ' Demander un accusé de réception (Oui ou Non)
    
    ' Pour un corps en texte brute
        Const strBodyMail    As String = "Bonjour," & vbCrLf & vbCrLf & _
                                         "Veuillez trouver ci-joint le " & _
                                         "document PDF." ' Corps du mail
    ' Pour un corps en HTML
         Const strHTMLBodyMail     As String = "" ' Valeur "" pour utiliser la version en texte brute (strBodyMail)
'       Exemple de chaîne possible :
'       ----------------------------
'        Const strHTMLBodyMail As String = "<p>Bonjour,</p><br>" & _
                                            "<p>Un site <span style=""color: #ff0000;""><strong>super</strong> </span>:" & _
                                            "<a href=""http://www.1forme.fr"">www.1forme.fr</a></p><br>" & _
                                            "<p>Merci de consulter le document en pièce jointe.</p>"
    ' Variables (ne pas modifier)
    Dim objMailMerge    As MailMerge
    Dim i               As Integer
    Dim intNbEnrg       As Integer
    Dim strTempFilePath As String
    Dim strTempFileName As String
    Dim strMail_To      As String
    Dim strMail_CC      As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set OutApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo fin
    
    Set objMailMerge = ActiveDocument.MailMerge
    strTempFilePath = Environ("temp") & "\"
    intNbEnrg = objMailMerge.DataSource.RecordCount
    For i = 0 To intNbEnrg - 1
        With objMailMerge
            .DataSource.FirstRecord = i + 1
            .DataSource.LastRecord = i + 1
            .Destination = wdSendToNewDocument
            .DataSource.ActiveRecord = i + 1
            strTempFileName = .DataSource.DataFields(strChampNomFichier) & ".pdf"
            strMail_To = .DataSource.DataFields(strChampMail_To)
            If strChampMail_CC <> "" Then strMail_CC = .DataSource.DataFields(strChampMail_CC)
            .Execute
        End With
        ActiveDocument.ExportAsFixedFormat OutputFileName:=strTempFilePath & strTempFileName, ExportFormat:=wdExportFormatPDF, openafterexport:=False
        ActiveDocument.Close savechanges:=False
        Set OutMail = OutApp.CreateItem(0) ' olMailItem (Nom cst non interprétable)
        With OutMail
            .Subject = strObjetMail
            .To = strMail_To
            .CC = strMail_CC
            If strHTMLBodyMail <> "" Then
                .HTMLBody = strHTMLBodyMail
            Else
                .Body = strBodyMail
            End If
            .Attachments.Add strTempFilePath & strTempFileName
            .Importance = IIf(strImportant = "Oui", 2, 1) ' 2= olImportanceHigh, 1= olImportanceNormal
            .OriginatorDeliveryReportRequested = (strAccReception = "Oui")
            
            ' A paramétrer !
            ' ==============
            .Display ' Afficher l'e-mail (Commenter cette ligne pour un envoie automatique)
            '.Send   ' Envoyer l'e-mail (Décommenter cette ligne pour un envoie automatique)
            
        End With
            Kill strTempFilePath & strTempFileName ' Nettoyage fichiers temporaires
    Next
fin:    
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set objMailMerge = Nothing
End Sub