Exécution de Word Mail Fusionner

Si votre document Word est déjà configuré avec les champs Fusion, et vous exécutez la macro du classeur contenant les données que vous souhaitez fusionner dans le document Word, puis essayez ceci:

Sub RunMerge()

    Dim wd As Object
    Dim wdocSource As Object

    Dim strWorkbookName As String

    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open("c:\test\WordMerge.docx")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM `Sheet1$`"

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

    wd.Visible = True
    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing

End Sub

Si votre document Word est déjà configuré avec la source de données et la mise en page des champs Fusionner, il devient beaucoup plus simple. Dans l'exemple ci-dessous MailmergelayOnt.doc Strort> est prêt à effectuer une fusion. Un bouton d'Excel est lié à Runmailmerge () Strong> comme ci-dessous. Tout le code est contenu dans un module Excel VBA.

Sub RunMailMerge()

    Dim wdOutputName, wdInputName As String
    wdOutputName = ThisWorkbook.Path & "\Reminder Letters " & Format(Date, "d mmm yyyy")
    wdInputName = ThisWorkbook.Path & "\MailMergeLayout.doc"

    ' open the mail merge layout file
    Dim wdDoc As Object
    Set wdDoc = GetObject(wdInputName, "Word.document")
    wdDoc.Application.Visible = True

    With wdDoc.MailMerge
         .MainDocumentType = wdFormLetters
         .Destination = wdSendToNewDocument
         .SuppressBlankLines = True
         .Execute Pause:=False
    End With

    ' show and save output file
    wdDoc.Application.Visible = True
    wdDoc.Application.ActiveDocument.SaveAs wdOutputName

    ' cleanup
    wdDoc.Close SaveChanges:=False
    Set wdDoc = Nothing

End Sub

Pour que la solution de DendariII au travail, je devais déclarer des constantes de mots dans Excel VBA comme suit:

' Word constants
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16

Private Sub CommandButton1_Click()

 Set wordapp = CreateObject("word.Application")

     wordapp.documents.Open "C:\Documents and Settings\User\Desktop\mergeletter.doc"


    wordapp.Visible = True

    wrddoc = wordapp.documents("C:\Users\User\Desktop\sourceofletters.xls")


   wrddoc.mailmerge.maindocumenttype = wdformletters

   With wrddoc.activedocument.mailmerge

 .OpenDataSource Name:="C:\Users\User\Desktop\sourceofletters.xls", _
           SQLStatement:="SELECT * FROM `Sheet1`"



   End With

End Sub
Above code is to open a word mailmerge document (with its source link and mergefield codes all setup ) all I want is for the message box "Opening the document will run the following SQL command " to be made available to the user , from that point forward the user could either select 'Yes' or 'No'. 

Dim opt As String
opt = MessageBox("Opening the document will run the following SQL command", vbYesNo)
If opt = vbYes Then
   'execute query
End If