【Word VBA】差し込み印刷でレコード毎に別ファイルで保存

2014年3月7日

, 
関連記事（docx形式でファイルを保存します）：
【コード】差し込み印刷でレコード毎に別ファイルで保存（その２）
関連記事（チェックしたレコードのみ処理対象にします）：
【コード】差し込み印刷でレコード毎に別ファイルで保存（その３）

セミナー受講生から、差し込み印刷に関する質問をいただきました。

例えば、100個のレコードを用いて差し込み印刷の「個々のドキュメントの編集」を実行する場合、1つのファイルにセクション区切りされた100個のレコードが作られます。

個別にファイルに保存するとなると、セクションごとに内容をコピペしなければならず大変な作業になります。

その対応策として、ネット上にはいろいろマクロが紹介されているようです。やっぱりこの手のことは必要ですね。

今回、私も１つ作ってみました。

このマクロでできること

差し込み印刷用のメイン文書に宛先のリスト（Excelファイルなど）が設定されている状態でマクロを実行します。

すると、このリストに掲載されたレコードをすべて差し込んだファイルが作成されます。

作成されるファイルは、フィールド名（又は、Excelファイルの列名）の”名前”に記載された値をファイル名とします。

メイン文書と同じフォルダにファイルが保存されます。

作成したファイルをすべて閉じます。

マクロの解説

37行目で保存用のファイル名を設定しています。

46行目でファイルを閉じます。開いたままにする場合にはこの項目を削除してください。

26行～31行を修正しました。（2014/03/09)

マクロ


Sub 差し込み印刷_レコード毎に別ファイルで保存()
　
　Dim i As Integer
　Dim iMax As Integer
　Dim myName As String
　Dim myMainDoc As Document
　Dim myNewDoc As Document
　　
　Set myMainDoc = ActiveDocument
　
　With myMainDoc.MailMerge
　　
　　'レコード数の設定
　　.DataSource.ActiveRecord = wdLastRecord
　　iMax = .DataSource.ActiveRecord
　　
　　'新規文書に書き出す
　　.Destination = wdSendToNewDocument
　　
　　'空白の差し込みフィールドを印刷しない
　　.SuppressBlankLines = True
　　
　　For i = 1 To iMax

　　　'レコードの指定
　　　'.DataSource.ActiveRecord = i　'削除しました。
　　　With .DataSource
　　　　.FirstRecord = i
　　　　.LastRecord = i
　　　　.ActiveRecord = i　'追加しました。誤記を失礼しました。
　　　End With
　　　
　　　'文書作成（差し込みエラー時に停止）
　　　.Execute Pause:=True
　　　
　　　'ファイル名に用いる文字列（項目名を設定してください）
　　　myName = .DataSource.DataFields("名前").Value
　　　
　　　'新規文書に名前をつけて保存
　　　Set myNewDoc = ActiveDocument
　　　If myName <> "" Then
　　　　myNewDoc.SaveAs FileName:=myMainDoc.Path & "\" & _
　　　　　　　　　　　　myName & ".doc", _
　　　　　　　　　　　　FileFormat:=wdFormatDocument, _
　　　　　　　　　　　　AddToRecentFiles:=False
　　　　myNewDoc.Close
　　　End If
　　　DoEvents
　　　
　　Next i
　
　End With
　
　Set myMainDoc = Nothing
　Set myNewDoc = Nothing
　　
End Sub

関連記事

-コード
-,