以前紹介しました「【Wordマクロ】差し込み印刷でレコード毎に別ファイルで保存
」、「【Wordマクロ】差し込み印刷でレコード毎に別ファイルで保存（その２）
」に続いて、応用技を紹介します。
BIT-Aさんのセミナー
を担当させていただいた時に、受講生から要望をいただきました。紹介するタイミングを逸しておりましたのでこの機会に。
このマクロもWordの差し込み印刷機能を使っています。ファイルの自動生成マクロです。
これまでに紹介したマクロと違うのは、フォルダ別に保存するということです。
フォルダ名は差し込み印刷に用いる宛先のリストの任意の項目を用いることができます。
分類して保存をする場合に便利ですね。
▼このマクロでできること
差し込み印刷で作成するWordファイルを、指定したフォルダ名と指定したファイル名で１つずつ保存します。
フォルダは、差し込み印刷のメイン文書が保存されているフォルダに作成されます。
▼マクロの解説
今までのマクロと同様、差し込み印刷の方法については説明を割愛させていただきます。
以下のマクロでは、「セミナー名」という項目をフォルダ名にしています。
ここは、任意の項目を選択できますので、差し込むデータにより使い分けてください。
赤文字部分でフォルダ作成をします。
.docx形式で保存しています。.doc形式での保存の場合は、少し修正が必要になります。
これまでの2つの記事をご覧ください。
▼マクロ
Sub 差し込み印刷_レコード毎に別ファイルで保存_フォルダ分け()
Dim i As Integer
Dim iMax As Integer
Dim myName As String
Dim myFolder As String
Dim myFolderPath As String
Dim myMainDoc As Document
Dim myNewDoc As Document
Set myMainDoc = ActiveDocument
With myMainDoc.MailMerge
'レコード数の設定
iMax = .DataSource.RecordCount
'新規文書に書き出す
.Destination = wdSendToNewDocument
'空白の差し込みフィールドを印刷しない
.SuppressBlankLines = True
For i = 1 To iMax
'レコードの指定
With .DataSource
.ActiveRecord = i
.FirstRecord = i
.LastRecord = i
End With
'文書作成（差し込みエラー時に停止）
.Execute Pause:=True
'ファイル名に用いる文字列（項目名を設定してください）
myName = .DataSource.DataFields("名前").Value
'フォルダ名に用いる文字列
myFolder = .DataSource.DataFields("セミナー名").Value
'フォルダがない場合フォルダを作成
myFolderPath = myMainDoc.Path & "\" & myFolder
If Dir(myFolderPath, vbDirectory) = "" Then
MkDir Path:=myFolderPath
End If
'新規文書に名前をつけて保存
Set myNewDoc = ActiveDocument
If myName <> "" Then
myNewDoc.SaveAs _
FileName:=myFolderPath & "\" & myName & ".docx", _
FileFormat:=wdFormatXMLDocument, _
AddToRecentFiles:=False
myNewDoc.Close
End If
DoEvents
Next i
End With
Set myMainDoc = Nothing
Set myNewDoc = Nothing
End Sub
▼関連記事
【Wordマクロ】差し込み印刷でレコード毎に別ファイルで保存 .doc形式で保存
【Wordマクロ】差し込み印刷でレコード毎に別ファイルで保存（その２）
.docx 形式で保存
↧
【Wordマクロ】差し込み印刷でレコード毎に別ファイルで保存（その３）
↧