Macro pour un publipostage Excel/Word

Sub Publipostage(AdrSource As String, AdrWd As String, AdrDest As String)
Dim Wkb As Workbook, MonWord As Object, MonDoc As Object, Conn As String, DocRes As Object
    Application.ScreenUpdating = False
    Set MonWord = CreateObject("Word.Application")
    MonWord.DisplayAlerts = 0
    Set MonDoc = MonWord.Documents.Open(Filename:=AdrWd, ConfirmConversions:=True, _
        ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=0, XMLTransform:="")
    Conn = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & AdrSource & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
        "Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:D"
    MonDoc.MailMerge.OpenDataSource Name:=AdrSource, ConfirmConversions:=False, _
        ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=0, _
        Connection:=Conn, SQLStatement:="SELECT * FROM `Feuil1$`", SQLStatement1:="", _
        SubType:=1
        With MonDoc.MailMerge
            .Destination = 0
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = 1
                .LastRecord = -16
            End With
            .Execute Pause:=False
        End With
    MonDoc.Close False
    Set DocRes = MonWord.ActiveDocument
    DocRes.SaveAs2 Filename:=AdrDest, FileFormat:=12, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, _
        WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=14
    DocRes.Close False
    MonWord.DisplayAlerts = -1
    Set MonDoc = Nothing
    Set DocRes = Nothing
    MonWord.Quit
    Set MonWord = Nothing
    Application.ScreenUpdating = True
End Sub

Sub ouvrir_word()

    Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Open("\MonChemin\")
    wrdApp.Visible = True
   
End Sub

Sub publipostageCC()
'
' publipostageCC Macro
'
'
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    
    Dim nom
        nom = ActiveDocument.Paragraphs(47).Range.Words(1)
    Dim prenom
        prenom = ActiveDocument.Paragraphs(47).Range.Words(2)
        
    ChangeFileOpenDirectory _
        "MonChemindEnregistrement\"
    
    ActiveDocument.SaveAs FileName:= _
        "Monchemin\Convention " & nom & "" & prenom & ".doc" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
        ActiveWindow.Close

End Sub