Word 差込印刷のレコードごとにファイルを生成するマクロ

Wordの差込印刷でレコードごとにファイルを保存

普段、仕事で差込印刷をよく使うんだが、「レコードごとに別々のファイルにしてくんねーかなー」と思っていた。

以前は、

1. 一旦、PDFにする
2. １ページづつバラす
3. それぞれにファイル名をつける

というおっそろしくメンドクサイことをしていたが（まあ、他の人が１個づつファイルを作っているのに比べたらそれでもだいぶ効率的なんですけど）、ggりまくって次のページにたどり着いた。

参考サイト１

「みんなのワードマクロ」様。

コチラのサンプルコードは、差込印刷のレコードごとに新しいドキュメントを生成していく、というもの。

これだよ、これ！　まさにこういうのが欲しかったんだよ！

という言葉しかございません。

差込印刷がMailMergeオブジェクトを使うんだなんて、いったいどうやってたどり着いたんだろ？

ただただすげえな、と思うばかり。

参考サイト２

VBA界では超有名な「インストラクターのネタ帳」様。

コチラのページからは、アクティブなページを削除するというワザを拝借しました。

標準モジュールのコード

ほとんど丸ごといただいたみたいなコードですが、めちゃ便利なので載っけときます。

Const FOLDER_NAME As String = "★作成した文書"    'フォルダ名を変えたらここを変えること。'

Sub insertionPrintAndCreateNewDoc()
  If Dir(ThisDocument.Path & "\" & FOLDER_NAME, vbDirectory) = "" Then    '……(1)'
    Call MkDir(ThisDocument.Path & "\" & FOLDER_NAME)
    Call MsgBox("作成済みファイルを保存するフォルダ「" & FOLDER_NAME & _
                "」を、このファイルのあるディレクトリに作成しました。", vbInformation)
  End If
  Dim folderPath As String
  folderPath = ThisDocument.Path & "\" & FOLDER_NAME & "\"
  Dim baseDoc As Document    '……(2)'
  Dim newDoc As Document     '……(3)'
  Set baseDoc = ThisDocument   '……(4)'
On Error GoTo HandleError
  With baseDoc.MailMerge
    Dim maxRec As Integer
    maxRec = .DataSource.RecordCount   '……(5)'
    .Destination = wdSendToNewDocument '……(6)'
    .SuppressBlankLines = True
    Dim i As Integer
    For i = 1 To maxRec    '……(7)'
      With .DataSource
        .ActiveRecord = i  '……(8)'
        .FirstRecord = i
        .LastRecord = i
      End With
      Call .Execute(Pause:=True)
      DoEvents             '……(9)'
      Set newDoc = ActiveDocument
      Dim tgtFileName As String
      tgtFileName = .DataSource.DataFields("卒業期").Value & "期 " & _
                    .DataSource.DataFields("選手名").Value  '……(10)'
      If tgtFileName <> "" Then
        Call newDoc.Bookmarks("\Page").Range.Delete   '……(11)'
        Call newDoc.SaveAs( _
                      fileName:=folderPath & tgtFileName & ".docx", _
                      fileformat:=wdFormatXMLDocument, _
                      addtorecentfiles:=False)    '……(12)'
        Call newDoc.Close
      End If
      DoEvents
    Next
  End With
  Set baseDoc = Nothing
  Set newDoc = Nothing
Exit Sub

HandleError:
  Call MsgBox("エラーが発生しました。差込設定を見直すなど、設定を再確認してください。", vbExclamation)
End Sub

コードの説明

• (1)は、よくやるやつ。新しくできるファイルを保存するフォルダの有無を調べて、なかったら作る。
• (2)は、元のWordドキュメントを格納する変数。
• (3)は、新しくできるドキュメントを格納する変数。
• (4)で、マクロを書いているこのドキュメントを変数baseDocに格納。
• (5)で、変数maxRecにレコード数を格納。MailMerge.DataSourceオブジェクトのRecordCountプロパティから取得できる。
• (6)で、MailMergeオブジェクトのDestinationプロパティに定数wdSendToNewDocumentをセットしている。この定数をセットすると、とにかくこういうことになるらしいよ。
• (7)で、レコード数ぶんForループ。
• (8)からの３行。DataSourceオブジェクトのActiveRecord、FirstRecord、LastRecordの全てに同じ数字をセットすることで、１レコード１文書にしているのだと思う。
• (9)。よく分からんのだが、ここにDoEventsを入れていなかったら、ひたすら白紙文書がレコード数ぶん生産される。
• (10)で、新しくできるドキュメントのファイル名を作成。DataField(フィールド名)オブジェクトのValueプロパティを使えば、当該レコードのフィールドの文字列を呼んでくることができる。
• (11)で、最初のページを削除している。イマイチ理屈が分からんのだが。Bookmarksコレクションってのがあるんでしょうな。すまん、勉強不足で。（＊）
• (12)では、SaveAsメソッドを用いて新しくできたドキュメント（「定型書簡○○」って名前になっている）に名前を付けて保存している。

実行

差込データソースはこんな風に作っておいた。

差込フィールドは、ドキュメントの２ページ目に、こんな風に設定。

１ページ目には、こんな風にコマンドボタンを置いておいて、

ThisDocumentモジュールに、

Private Sub CommandButton1_Click()
  Call insertionPrintAndCreateNewDoc
End Sub

こんな風にコードを書いておく。

ボタンを押すと、

保存用フォルダが作られて、

こんな風にファイルが作られる。

試しに一つ開いてみると、

こんな感じ。

おわりに

ほとんど借り物みたいなコードですが、めちゃくちゃ便利で重宝しております。

追記

コチラもどうぞ！

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

さらに追記

「Bookmarks(\Page)」については、コチラを参照のこと。「定義済みブックマーク」というらしいよ！〔戻る〕