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

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

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

以前は、

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

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

参考サイト1

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

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

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

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

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

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

参考サイト2

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

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

標準モジュールのコード

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

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

Sub insertionPrintAndCreateNewDoc()
  If Dir(ThisDocument.Path & "\" & FOLDER_NAME, vbDirectory) = "" Then    '……(1)'
    MkDir ThisDocument.Path & "\" & FOLDER_NAME
    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 myError
  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
      .Execute pause:=True
      DoEvents             '……(9)'
      Set newDoc = ActiveDocument
      Dim tgtFileName As String
      tgtFileName = .DataSource.DataFields("卒業期").Value & "期 " & _
                    .DataSource.DataFields("選手名").Value  '……(10)'
      If tgtFileName <> "" Then
        newDoc.Bookmarks("\Page").Range.Delete   '……(11)'
        newDoc.SaveAs _
                fileName:=folderPath & tgtFileName & ".docx", _
                fileformat:=wdFormatXMLDocument, _
                addtorecentfiles:=False    '……(12)'
        newDoc.Close
      End If
      DoEvents
    Next i
  End With
  Set baseDoc = Nothing
  Set newDoc = Nothing
Exit Sub

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

コードの説明

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

実行

f:id:akashi_keirin:20170325223427j:plain

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

f:id:akashi_keirin:20170325223434j:plain

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

f:id:akashi_keirin:20170325223440j:plain

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

ThisDocumentモジュールに、

f:id:akashi_keirin:20170325223448j:plain

Private Sub CommandButton1_Click()
  Call insertionPrintAndCreateNewDoc
End Sub

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

f:id:akashi_keirin:20170325223459j:plain

ボタンを押すと、

f:id:akashi_keirin:20170325223510j:plain

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

f:id:akashi_keirin:20170325223522j:plain

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

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

f:id:akashi_keirin:20170325223528j:plain

こんな感じ。

おわりに

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

@akashi_keirin on Twitter