Выполнить слияние почты Publisher из Excel - PullRequest
Новая
       34

Выполнить слияние почты Publisher из Excel

1 голос
/ 03 ноября 2019

У меня есть макрос в Excel, который запускает слияние почты в издателе. Я хочу добавить фильтр к нему. Кто-нибудь знает, как добавить его в текущий код -

Фильтр, который я хочу добавить sheet = "ALL Sections $", colIndex = icol, критерии = "part1name"

Спасибо

Код, который у меня есть для запуска слияния в издателе: 

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

1 Ответ

1 голос
/ 06 ноября 2019

[решено] Я наконец-то понял, как применять мои фильтры, и несколько других проблем, которые я обнаружил на этом пути - вряд ли есть какая-либо информация о слиянии писем издателя.

код: 

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
...