Sub RunMerge()







    Dim strWorkbookName As String, Rslt
    strWorkbookName = ThisWorkbook.FullName
    Dim wdapp As New Word.Application
    Dim wddoc As Word.Document
    Rslt = InputBox("Please choose a merge type:" & vbCr & _
      "1. Letter merge" & vbCr & _
      "2. Label merge" & vbCr & _
      "3. Envelope merge")
    If Rslt = vbCancel Then Exit Sub
    Rslt = Trim(Rslt)
    If Not IsNumeric(Rslt) Then Exit Sub
    If (Rslt > 3) Or (Rslt < 1) Then Exit Sub
    With wdapp
        'Disable alerts to prevent an SQL prompt
        .DisplayAlerts = wdAlertsNone
        'Open the mailmerge main document
        Select Case Rslt
          Case 1
            Set wddoc = .Documents.Open(ThisWorkbook.Path & "\Letter Mail Merge Main Document.docx")
          Case 2
            Set wddoc = .Documents.Open(ThisWorkbook.Path & "\Label Mail Merge Main Document.docx")
          Case 3
            Set wddoc = .Documents.Open(ThisWorkbook.Path & "\Envelope Mail Merge Main Document.docx")
        End Select
        With wddoc
            With .MailMerge
                'Define the mailmerge type
                Select Case Rslt
                  Case 1
                    .MainDocumentType = wdFormLetters
                  Case 2
                    .MainDocumentType = wdMailingLabels
                  Case 3
                    .MainDocumentType = wdEnvelopes
                End Select
                'Connect to the data source
                .OpenDataSource Name:=strWorkbookName, ReadOnly:=True, _
                  AddToRecentFiles:=False, LinkToSource:=False, _
                  Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                  "User ID=Admin;Data Source=strWorkbookName;" & _
                  "Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                  SQLStatement:="SELECT * FROM `Sheet1$`", _
                  SubType:=wdMergeSubTypeAccess
                .SuppressBlankLines = True
                With .DataSource
                    .FirstRecord = wdDefaultFirstRecord
                    .LastRecord = wdDefaultLastRecord
                End With
                'Define the output
                .Destination = wdSendToNewDocument
                'Excecute the merge
                .Execute
                'Disconnect from the data source
                .MainDocumentType = wdNotAMergeDocument
            End With
            'Close the mailmerge main document
            .Close False
        End With
        'Restore the Word alerts
        .DisplayAlerts = wdAlertsAll
        'Print the output document
        .ActiveDocument.PrintOut
        'Display Word and the document
        .Visible = True
    End With
End Sub