0
(0)

Une petite macro pour faire un publipostage sous forme de pièce jointe en PDF dans des mails avec Outlook.

Créer votre publipostage normalement (document principal de fusion) puis exécuter la macro pour terminer la fusion.

La macro

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

Merci pour votre attention bienveillante.

Article intéressant ?

Cliquez sur une étoile pour noter cet article !

Note moyenne 0 / 5. Nombre de votes : 0

Aucun vote pour l'instant ! Soyez le premier à noter ce post.

Nous sommes désolés que cet article ne vous ait pas été utile !

Améliorons cet article !

Dites nous comment nous pouvons améliorer cet article ?

Publications similaires

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *