関連記事（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