Public Sub SaveToPDF()
  Dim sFilePath As String
  
  ActiveDocument.Save
  sFilePath = ActiveDocument.FullName & ".pdf"
  ActiveDocument.SaveAs2 FileName:=sFilePath, FileFormat:=wdFormatPDF
  MergePDFs sFilePath
End Sub

Sub MergePDFs(sPDF As String)
   ' Reference required: "VBE - Tools - References - Acrobat"
  Dim a As Variant, i As Long, n As Long, ni As Long, p As String
  Dim AcroApp As New Acrobat.AcroApp
  Dim fd As Office.FileDialog
  Dim oPDF As Acrobat.CAcroPDDoc
  Dim oNextPDF As Acrobat.CAcroPDDoc

  Set oPDF = CreateObject("AcroExch.PDDoc")
  oPDF.Open sPDF


  Set oNextPDF = CreateObject("AcroExch.PDDoc")

  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .AllowMultiSelect = True
    .Title = "Select the files to merge."
    .Filters.Clear
    .Filters.Add "Adobe Acrobat Pro", "*.pdf"
    If .Show = -1 Then
      For i = 1 To fd.SelectedItems.Count
        n = oPDF.GetNumPages()
        oNextPDF.Open .SelectedItems(i)
        ni = oNextPDF.GetNumPages()
        oPDF.InsertPages nInsertPageAfter:=n - 1, iPDDocSource:=oNextPDF, _
                  lStartPage:=1, lNumPages:=ni, lInsertFlags:=True
        oNextPDF.Close
      Next i
    End If
  End With

  oPDF.Save nType:=1, sFullPath:=sPDF
  oPDF.Close
  Set oPDF = Nothing
  Set oNextPDF = Nothing

   ' Quit Acrobat application
  AcroApp.Exit
  Set AcroApp = Nothing
End Sub