VBA Excel mail merge to publisher

MC 96 Reputation points
2019-11-03T21:53:47.957+00:00

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 Monitored
Not Monitored
Tag not monitored by Microsoft.
35,970 questions
0 comments No comments
{count} votes

Accepted answer
  1. MC 96 Reputation points
    2019-11-07T01:07:22.827+00:00
    1. I was asking about publisher now word. I only see reference to word.
      1. [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  
    
    0 comments No comments

1 additional answer

Sort by: Most helpful
  1. jun sun 16 Reputation points
    2019-11-05T08:46:39.113+00:00
    1 person found this answer helpful.
    0 comments No comments