Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub RunMerge()
- Dim wd As Object
- Dim wdocSource As Object
- Dim Last_Row As Integer
- Dim strWorkbookName As String
- Last_Row = Worksheets("_Main").Cells(52, 6).Value
- Const wdFormLetters = 0, wdOpenFormatAuto = 0
- Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = -16
- 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:UsersevieraDesktopCertificateTemplateCertificateTemplate_Re-entryV1.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 `_Main$`"
- 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
- With wdocSource.MailMerge
- .Destination = wdSendToNewDocument
- .SuppressBlankLines = True
- With .DataSource
- .FirstRecord = wdDefaultFirstRecord
- .LastRecord = wdDefaultLastRecord
- End With
Add Comment
Please, Sign In to add comment