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

関連記事(doc形式でファイルを保存します):
【コード】差し込み印刷でレコード毎に別ファイルで保存(その1)
関連記事(チェックしたレコードのみ処理対象にします):
【コード】差し込み印刷でレコード毎に別ファイルで保存(その3)

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

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

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

このマクロでできること

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

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

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

マクロの解説

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

それと同時に、フォーマットを43行目のように変更しました。

.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

関連記事

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

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

コメント

  1. 匿名 より:

    このマクロのおかげでだいぶ仕事が楽になりました。ありがとうございます。

    • 新田順也 より:

      コメントをどうもありがとうございます。お役に立ててよかったです!

  2. 高橋 より:

    こちらのマクロのおかげでかなり仕事が効率化できました。
    ありがとうございます。

    コメント欄で質問して良いのかわかりませんが、
    個別レコードをPDFで保存する方法はないでしょうか?
    下記コードでPDF形式では保存できるようになったのですが、
    1ファイルごとに「定型書簡Xに対する変更を保存しますか?」と出てきてしまいます。
    レコードが200ほどあるためうまくこの表示を消せないかと思っておりますが、
    VBAの知識が浅く中々うまく処理できていません。もしご助力いただけましたら幸いです。

    • 新田順也 より:

      高橋さん

      コメントをありがとうございます。
      「下記コード」とありましたが削除されてしまっているようです。
      もしコメントに書ききれないようでしたら、お問い合わせフォームからお送りください。よろしくお願いいたします。

  3. 真下 より:

    本日会社で急に60件近いデータを用意してくれ…と言われ、白目を剥いておりましたところ
    こちらのマクロのおかげで命拾いいたしました。
    大変便利なマクロで大いに感謝しているのですが、1点質問させていただきたく、もしお時間ございましたらご教示お願いできますと幸いです。

    こちらのマクロを実行した際、
    リスト(Excel)の通りにファイルが出来上がっているな…とみていたのですが
    途中から、作成しなくてはいけない件数をオーバーしてもマクロが止まらず、ctlr+Breakで中止する…といった状態になりました。

    このマクロを実行するにあたり、こういった事態に陥るケースというのは
    どのようなものが想定されますでしょうか…。
    お手数とは存じますが、ご教示お願いできますと幸いです。

    どうぞ宜しくお願いいたします。

    • 新田順也 より:

      真下さん
      うれしいコメントをありがとうございます!お役に立てて何よりです。
      このマクロでは、Excelのリストにあるレコードすべてを処理することを想定しています。チェック対象のみを処理するわけではありません。チェックを外すとエラーが出ると思うのですが、どのような状況で運用されているのかわからないので何とも言えません。。。
      ちょうど新しいマクロを準備していたので公開しました。こちらをお試しください。

      https://www.wordvbalab.com/code/15927/

  4. 真下 より:

    お世話になっております。
    サイトで質問させていただきました、真下でございます。

    ご多用のところ、早々にご確認、また丁寧なご返信の程
    ありがとうございます。
    こちらのご返信が遅くなり、大変申し訳ございません。

    マクロのブラッシュアップについて、
    まさかご対応いただけると思っておりませんでしたため、本当に驚いております。
    心から感謝申し上げます。

    早速、ブラッシュアップされたマクロを使用してみました!
    今度は、リストに用意していた行数分の繰り返しで、作業が完了しました!
    また、【ファイル名に使うフィル―ド名を実行時に入力する仕組み】についても
    汎用性の高い機能に感動を隠せませんでした…!

    あの拙いコメントに対し、こんなにも真摯にご対応いただき
    本当にありがとうございます。

    お忙しいところ恐れ入りますが、どうぞ宜しくお願い致します。

    • 新田順也 より:

      真下さん

      お試しをいただき、ありがとうございました!
      私が使うのであればあったほうがいいなと思う機能を作っていたところだったので、お役に立ててちょうどよかったです。

トップへ戻る