Community Center | Not monitored
Tag not monitored by Microsoft.
This browser is no longer supported.
Upgrade to Microsoft Edge to take advantage of the latest features, security updates, and technical support.
I created a macro to execute a mail merge in word, now i need to set one up for publisher but it seems that publisher uses different object codes, anyone know how i can adapt my code to publisher
WORD VBA:
Sub MailMergeWD()
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = GetObject(, "Word.Application") 'open word
wd.Quit savechanges:=wdDoNotSaveChanges ' closes word
wd.DisplayAlerts = 0 'dont bother me with alerts about normal template
Set wd = CreateObject("Word.Application") 'open word again
On Error GoTo 0
Set wdocSource = wd.Documents.Open("E:\users\sample.docx") 'ADD YOUR FILE PATH
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 [Sheet1$] " & _
"WHERE [Column1] > '0.00' " & _
"AND [Column2] like'%mark%'" 'add your SQL filter
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
On Error GoTo End_Sub_error 'if error end sub
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close savechanges:=wdDoNotSaveChanges 'WILL CLOSE SOURCE
wd.PrintOut 'WILL PRINT MAIL MERGE
wd.ActiveDocument.Close savechanges:=wdDoNotSaveChanges 'WILL CLOSE MAIL MERGE
On Error Resume Next 'WILL PAUSE CODE
wd.Quit 'WILL CLOSE WORD
GoTo continue_now 'end sub
End_Sub_error:
wd.Quit savechanges:=wdDoNotSaveChanges
continue_now:
Set wdocSource = Nothing
Set wd = Nothing
End Sub
code:
Sub MergeToPub ()
Dim strWorkbookName As String
Dim pubSource As Object
Dim mrgMain As MailMerge
Dim appPub As New Publisher.Application
Dim FileLink As String
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
FileLink = [MailMergePub].Value
appPub.ActiveWindow.Visible = True
Set pubSource = appPub.Open(FileLink)
Set mrgMain = pubSource.MailMerge
'before i added this next line of code, for some reason
'it added the same data source twice and merged duplicate results
If pubSource.MailMerge.DataSource.Name = strWorkbookName Then GoTo ContinueCode
pubSource.MailMerge.OpenDataSource _
bstrDataSource:=strWorkbookName, _
bstrTable:="Sheet1$", _
fNeverPrompt:=True
ContinueCode:
'this adds two filters
With mrgMain.DataSource
.Filters.Add Column:="Column1", _
Comparison:=msoFilterComparisonEqual, _
Conjunction:=msoFilterConjunctionAnd, _
bstrCompareTo:="Name"
.Filters.Add Column:="Column2", _
Comparison:=msoFilterComparisonNotEqual, _
Conjunction:=msoFilterConjunctionAnd, _
bstrCompareTo:="yes"
.ApplyFilter
.FirstRecord = pbDefaultFirstRecord
.LastRecord = pbDefaultLastRecord
End With
mrgMain.Execute False,
pbMergeToNewPublication
pubSource.Close
Set appPub = Nothing
Set pubSource = Nothing
End Sub
Mendel, this link may help you...
https://blogs.msdn.microsoft.com/developingfordynamicsgp/2008/10/29/how-to-use-word-mail-merge-and-macros-to-import-data/