Not Monitored
Tag not monitored by Microsoft.
40,587 questions
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/