Dim WithEvents wdapp As Application
Dim aSteps As Variant
Dim bCustomProcessing As Boolean
Dim sHTML As String

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
   "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
   String, ByVal lpFile As String, ByVal lpParameters As String, _
   ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Document_Open()

    'Get a reference to the Word application to handle mail merge events.
    Set wdapp = Application
    
    'Initialization of the demonstration.
    aSteps = Array("Select document type", "Select starting document", "Select Recipients", _
                   "Write Your Letter", "Preview Your Letters", "Complete the Merge")
    bCustomProcessing = False
    ThisDocument.MailMerge.ShowWizard 1
    
End Sub

Private Sub Document_Close()
    Set wdapp = Nothing
End Sub

Private Sub wdapp_MailMergeWizardStateChange(ByVal Doc As Document,
    FromState As Long, ToState As Long, Handled As Boolean)
    
    'Print information that indicates which step is currently shown.
    Debug.Print "MailMergeWizardStateChange Event"
    Debug.Print "   - Starting Step " & ToState & " (" & aSteps(ToState - 1) & ")"

End Sub

Private Sub wdapp_MailMergeDataSourceLoad(ByVal Doc As Document)
    
    Dim oDS As MailMergeDataSource
    Set oDS = Doc.MailMerge.DataSource
 
    'Print information for the connected data source: the table name,
    ' the query string, and the list of fields in the data source.
    Debug.Print "MailMergeDataSourceLoad Event"
    Debug.Print "   - Table       : " & oDS.TableName
    Debug.Print "   - Query String: " & oDS.QueryString
    Dim sFieldNames As String
    For i = 1 To oDS.FieldNames.Count - 1
        sFieldNames = sFieldNames & oDS.FieldNames(i) & ","
    Next
    sFieldNames = sFieldNames & oDS.FieldNames(oDS.FieldNames.Count)
    Debug.Print "   - Field Names : " & sFieldNames
    
    'This shows "Custom Processing" in Step 6 of the Mail Merge Wizard.
    Doc.MailMerge.ShowSendToCustom = "Custom Processing"
    
End Sub

Private Sub wdapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
    
    Debug.Print "MailMergeBeforeRecordMerge Event"

End Sub

Private Sub wdapp_MailMergeAfterRecordMerge(ByVal Doc As Document)

    'Print information about which record was just processed for the merge.
    Debug.Print "MailMergeAfterRecordMerge Event"
    Debug.Print "   - Processed Record # " & Doc.MailMerge.DataSource.ActiveRecord
   
End Sub

Private Sub wdapp_MailMergeWizardSendToCustom(ByVal Doc As Document)

    Debug.Print "MailMergeWizardSendToCustom Event"
    
    'If the user selects "Custom Processing" in the last step of the mail
    'merge wizard, this event is fired. In this event handler, a file dialog box
    'prompts the user to select the name of a Web (.html) page. Then, the
    'mail merge is executed to a new document. The rest of the custom
    'processing is handled in the MailMergeAfterMerge event (which is
    'triggered by the Execute method); in the MailMergeAfterMerge event,
    'the new document is saved as HTML and displayed in the browser.
    
    Dim oDialog As FileDialog, i As Integer
    Set oDialog = Application.FileDialog(msoFileDialogSaveAs)
    oDialog.Title = "Save Mail Merge Results As..."
    For i = 1 To oDialog.Filters.Count
        If oDialog.Filters(i).Description = "Web Page" Then
            oDialog.FilterIndex = i
            Exit For
        End If
    Next
    If oDialog.Show Then
        Debug.Print "   - Proceed with Custom Processing"
        bCustomProcessing = True
        sHTML = oDialog.SelectedItems(1)
        Doc.MailMerge.Destination = wdSendToNewDocument
        Doc.MailMerge.Execute
    Else
        Debug.Print "   - Custom Processing Cancelled"
    End If
        
End Sub

Private Sub wdapp_MailMergeBeforeMerge(ByVal Doc As Document, ByVal
    StartRecord As Long, ByVal EndRecord As Long, Cancel As Boolean)

    Debug.Print "MailMergeBeforeMerge Event"
    
    'Give the user a chance to cancel the mail merge. The choice (to proceed or
    'to cancel) is printed.
    Dim lResult As Long
    lResult = MsgBox("You have selected to execute this mail merge. Are you sure?", vbYesNo)
    If lResult = vbNo Then
        Cancel = True
        Debug.Print "   - Mail Merge cancelled at your request"
    Else
        Debug.Print "   - Proceeding with Mail Merge"
    End If

End Sub

Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)

    'Print the count of records in the datasource and the name of the
    'resulting document if the user selected to merge to a "new document".
    Debug.Print "MailMergeAfterMerge Event"
    Debug.Print "   - Record Count: " & Doc.MailMerge.DataSource.RecordCount
    If Not (DocResult Is Nothing) And Not (bCustomProcessing) Then
        Debug.Print "   - New Document: " & DocResult.Name
    End If
    
    'For custom processing, save DocResult by using the HTML converter and
    'then display the resulting HTML file in the browser.
    If bCustomProcessing Then
        DocResult.SaveAs sHTML, wdFormatHTML
        DocResult.Close False
        ShellExecute 0, "Open", sHTML, "", "C:\", 1
        Debug.Print "   - Sent MailMerge results to the Browser"
    End If

End Sub