question

MC-1273 avatar image
0 Votes"
MC-1273 asked MC-1273 edited

VBA Excel mail merge to publisher

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


not-supported
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

MC-1273 avatar image
0 Votes"
MC-1273 answered MC-1273 edited
  1. I was asking about publisher now word. I only see reference to word.

  2. [Solved] I finally figured out how to run the vba, apply my filters and a few other problems i found along the way - there is hardly any info about publisher mail merge out there.

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


5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

jun-4948 avatar image
1 Vote"
jun-4948 answered
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.