【コード】差し込み印刷でレコード毎に別ファイルで保存(その2)

以前紹介しました「【コード】差し込み印刷でレコード毎に別ファイルで保存」を少し修正してみました。

上記の記事では、ファイルの保存形式がWord 2003までの.doc形式でした。

これを、.docx形式にしたいということです。

このマクロでできること

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

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

ファイルの保存形式を、Word 2007以降の.docx形式にします。

マクロの解説

.docx形式での保存なので、赤文字のように拡張子を変更しました。

それと同時に、フォーマットを青文字のように変更しました。

.docx形式のファイルは、XML形式のファイルなのです。

ここを、wdFormatDocument (.doc形式)のままにしておくと、拡張子(.docx)と整合がとれないためエラーになります。

マクロ


Sub 差し込み印刷_レコード毎に別ファイルで保存2()

 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

   'レコードの指定
   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 & ".docx", _
            FileFormat:=wdFormatXMLDocument, _
            AddToRecentFiles:=False
    myNewDoc.Close
   End If
   DoEvents
 
  Next i

 End With

 Set myMainDoc = Nothing
 Set myNewDoc = Nothing
 
End Sub

トップへ戻る