Search code examples
excelvbamailmergepublisher

Add filter to Publisher mail merge from Excel


I have a macro in Excel that runs a mail merge in Publisher.

How do I add this filter to the current code?

sheet="ALL Sections$", colIndex= icol, criteria="part1name"

Code to run mail merge in Publisher:

    Dim strWorkbookName As String
    Dim pubSource As Object
    Dim mrgMain As MailMerge
    Dim appPub As Object
    Dim FileLink As String

    FileLink = [Rank1MailMerge].Value
    Set appPub = CreateObject("Publisher.Application")
    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Set pubSource = appPub.Open(FileLink)
    Set mrgMain = pubSource.MailMerge

    pubSource.MailMerge.OpenDataSource _
      bstrDataSource:=strWorkbookName, _
      bstrTable:="ALL Sections$", _
      fNeverPrompt:=True

    With mrgMain.DataSource
        .FirstRecord = pbDefaultFirstRecord
        .LastRecord = pbDefaultLastRecord
    End With
    mrgMain.Execute False, pbMergeToNewPublication
    End Sub

Solution

  • [Solved] I finally figured out how to 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