View Single Post
 
Old 02-03-2019, 10:17 AM
Kenneth Hobson Kenneth Hobson is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Jun 2018
Posts: 37
Kenneth Hobson is on a distinguished road
Default

This should give you a good start. You will need to change the sheet name and add the column A loop counter. Both are trivial. If you need help with that, post back. Try it for one run first.

Code:
Sub Test_MergeRun()
  'Const wdocOutput As String = "C:\Program Files (x86)\Microsoft Dynamics\GP2015\Macros\ATT_Looper.txt"
  Const wdocForm As String = "C:\Program Files (x86)\Microsoft Dynamics\GP2015\Mail Merges\ATT_NE_MM_orig.docx"
  Const xlData As String = "\\Sasquatch\Common IS$\GP\Transfer Attendance\Mail Merge Creator.xlsm"
  Const StrSQL As String = "SELECT * FROM 'NonExempt$'"
  
  MergeRun wdocForm, xlData, StrSQL
End Sub

'If Word found locked fields shows after a merge, see this workaround:
'http://support.microsoft.com/kb/292155 - due to inline text in Autoshape layout.
'DataSources, https://support.office.com/en-us/article/Data-sources-you-can-use-for-a-mail-merge-9de322a6-f0f9-448d-a113-5fab317d9ef4

'MergeRun frmDoc, datFile, "SELECT * FROM `Sheet1$`"
'Requires Tools > References > Microsoft Word 11.0 Object Library
Sub MergeRun(frmFile As String, datFile As String, _
  SQL As String, _
  Optional bClose As Boolean = False, Optional bPrint As Boolean = False, _
  Optional iNoCopies As Integer = 1)
  
  Dim wdApp As Word.Application
  Dim myDoc As Word.Document
  
  'Tell user what file is missing and exit.
  If Dir(frmFile) = "" Then
    MsgBox "Form file does not exist." & vbLf & frmFile, _
      vbCritical, "Exit - Missing Form File"
  End If
  If Dir(datFile) = "" Then
    MsgBox "Data file does not exist." & vbLf & datFile, _
      vbCritical, "Exit - Missing Data File"
  End If
  If Dir(frmFile) = "" Or Dir(datFile) = "" Then Exit Sub
  
  On Error Resume Next
  Set wdApp = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
      Set wdApp = CreateObject("Word.Application")
  End If
  On Error GoTo errorHandler
  
  With wdApp
   On Error GoTo errorHandler
    wdApp.Application.DisplayAlerts = wdAlertsNone
    
    'Open form file and associate data file
    Set myDoc = .Documents.Open(frmFile, False, True, False)
    .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    .ActiveDocument.MailMerge.OpenDataSource Name:=datFile, _
      ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
      AddToRecentFiles:=False, PassWordDocument:="", PasswordTemplate:="", _
      WritePassWordDocument:="", WritePasswordTemplate:="", Revert:=False, _
      Format:=wdOpenFormatAuto, Connection:="", SQLStatement:=SQL, SQLStatement1 _
      :="", SubType:=wdMergeSubTypeOther
    'Merge to a new document
    With wdApp.ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    .Visible = True
    
    If bPrint = True Then
      .Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=iNoCopies, Pages:="", PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
    End If
    
    If bClose = True Then
      .ActiveDocument.Close False
      .ActiveDocument.Close False
    End If

    wdApp.Application.DisplayAlerts = wdAlertsAll
  End With
     
errorExit:
    On Error Resume Next
    myDoc.Close False
    Set myDoc = Nothing
    Set wdApp = Nothing
    Exit Sub
 
errorHandler:
    MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
    Resume errorExit
End Sub
Reply With Quote