【word vba】差し込み印刷をマクロで制御（備忘録）

基本操作

Sub testMMDS()
    Dim mmds As MailMergeDataSource
    Set mmds = ActiveDocument.MailMerge.DataSource
    
    Debug.Print mmds.ConnectString
    Debug.Print mmds.QueryString
    Debug.Print mmds.TableName
    Debug.Print mmds.Name
    
    Dim i As Long
    For i = 1 To mmds.RecordCount
        mmds.ActiveRecord = i
        Debug.Print mmds.ActiveRecord
        
        Dim mmdf As MailMergeDataField
        For Each mmdf In mmds.DataFields
            Debug.Print mmdf.Name & ":" & mmdf.Value
        Next
    Next
    mmds.ActiveRecord = wdFirstRecord
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = True
End Sub

※TableNameとNameは読み取り専用。

フィルター操作

テーブル名はエクセルワークシートを想定

参照設定：Microsoft VBScript Regular Expressions

Public Sub filterMMDS()
    On Error GoTo ErrorHandler
    Dim mmds As Word.MailMergeDataSource
    Set mmds = ActiveDocument.MailMerge.DataSource
    
    Dim re As RegExp
    Set re = New RegExp
    re.Pattern = "SELECT \* FROM `[^$]*\$[^`]*`"
    
    Dim mc As MatchCollection
    Set mc = re.Execute(mmds.QueryString)
    
    Dim BaseQuery As String
    BaseQuery = mc(0)
    
    Dim tmp As Variant
    tmp = Split(InputBox("nameとageをカンマ区切りで入力"), ",")
    
    Dim myName As String
    Dim myAge As Long
    myName = "'" & tmp(0) & "'"
    myAge = tmp(1)
    
    mmds.QueryString = BaseQuery & " WHERE name=" & myName & " AND age=" & myAge
    MsgBox "抽出件数は" & mmds.RecordCount & "件です。"
    Exit Sub

ErrorHandler:
    mmds.QueryString = BaseQuery
    MsgBox "抽出条件をクリアしました"
End Sub

※数値データをシングルクォテーションで囲ってもVBA上は動作するが、QueryStringにシングルクォテーションを残したまま保存すると、次回起動時にデータ参照エラーが出てしまうので、文字列データだけをシングルクォテーションで囲う。

※QueryStringのフィールド名はwordの仕様上バッククォートで囲うようだが、囲わなくてもOK。ファイル再起動時も影響なし（バージョンによるかも）

※使用できるSQL構文は、AND/OR、=/<>/</>/<=/>=、WHERE、ORDER BY、ASC/DESC

イベントハンドラー

差し込み印刷でファイルに出力したときに、出力先のdocumentオブジェクトを捕捉する例。

Documentモジュールに記載

Option Explicit
Private WithEvents WordApp As Word.Application
 
Private Sub Document_Open()
    Set WordApp = Word.Application
End Sub
 
Public Sub testMailMerge()
    Dim mm As MailMerge
    Set mm = ActiveDocument.MailMerge
    mm.Destination = wdSendToNewDocument
    mm.Execute 'イベント発生
End Sub
 
Private Sub WordApp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
    Debug.Print DocResult.Name
End Sub

※クラスモジュールでの実装も可

※Document_Open以外でも任意のタイミングでWord.Applicationを捕捉すればよい

※testMailMergeで差し込み印刷を実行しているが、マクロからの実行でもリボンからの操作での実行でもイベントは捉えられる。

レコードごとに個別ファイル（docx, pdf）で保存

DocumentモジュールかClassモジュールに記載

Option Explicit
Private WithEvents WordApp As Word.Application
 
Public Sub SaveEachRecord()
    Set WordApp = Word.Application
 
    Dim mm As MailMerge
    Set mm = ActiveDocument.MailMerge
    mm.Destination = wdSendToNewDocument
 
    Dim mmds As MailMergeDataSource
    Set mmds = mm.DataSource
 
    Dim i As Long
    For i = 1 To mmds.RecordCount
        With mmds
            .ActiveRecord = i
            .FirstRecord = i
            .LastRecord = i
        End With
        mm.Execute 'イベント発生
    Next
 
    With mmds
        .ActiveRecord = wdDefaultFirstRecord
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
End Sub
 
Private Sub WordApp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
    Dim mmds As MailMergeDataSource
    Set mmds = Doc.MailMerge.DataSource
 
    Dim OutputFile As String
    OutputFile = Doc.Path & "\" & Format(mmds.ActiveRecord, "00_") & mmds.DataFields("hogehoge").Value
 
    With DocResult
        .SaveAs2 FileName:=OutputFile & ".docx"
        .ExportAsFixedFormat OutputFileName:=OutputFile & ".pdf", ExportFormat:=wdExportFormatPDF
        .Close SaveChanges:=False
    End With
End Sub