【実務・中級編】【中級者向け】表の各行を独立したファイルとして分割保存するドキュメント自動生成 – Word VBA解析バイブル

はじめに：なぜ現場の「差し込み印刷マクロ」は破綻するのか

開発チームを率いていると、現場から「ExcelやWordの巨大な一覧表から、1行ずつデータを抜き出して個別ファイル（注文書、通知書、契約書など）を作成するVBAが重い、途中で落ちる」という悲鳴が上がってくることが多々あります。

コードをレビューすると、決まって次のようなアンチパターンが見つかります。

• `Selection` オブジェクトを乱用して画面をスクロールさせながらコピペを繰り返している。
• Word表（Table）のセル末尾に潜む「制御文字」を処理せず、ファイル名やテキストのレイアウトが崩壊している。
• ドキュメントのオープン／クローズに伴うメモリリーク（COMオブジェクトの解放漏れ）を放置し、数百件の処理でWordプロセスがハングアップする。

「動くだけ」のコードと「数千件のバッチ処理に耐える」プロダクションコードの間には、COMオブジェクトのライフサイクル管理とWordドキュメントの内部構造に対する解像度の差という決定的な断絶があります。

今回は、マスター表の各行を読み取り、美しく設計されたテンプレート文書に安全・高速に流し込んで独立したWord文書として分割保存する、堅牢なドキュメント自動生成エンジンのアーキテクチャを伝授します。

—

1. アーキテクチャ設計：3つの鉄則

大規模ドキュメント生成を成功させるためには、コーディングに入る前に以下の原則を徹底する必要があります。

① UI非依存（Selectionの完全排除）

画面描画を伴う `Selection` は、実行速度を劇的に低下させるだけでなく、ユーザーのクリック一つでフォーカスが狂い、誤作動を引き起こす爆弾です。すべての操作はメモリ上の `Range` オブジェクトに対して直接行います。

② テンプレートのクローン戦略（非破壊設計）

元のテンプレートファイルを直接編集して「別名保存」を繰り返す設計はNGです。処理途中の異常終了時にテンプレートが破損するリスクがあります。
Wordの `Documents.Add(Template:=…)` メソッドを使用し、テンプレートをベースにした完全な新規ドキュメント（未保存インスタンス）をメモリ上に生成し、そこにデータを注入して保存します。

③ セル終端文字（`Chr(13) & Chr(7)`）の無害化

Wordのテーブルを扱う上で最大のトラップが、セル内に存在する「セル終端記号（End-of-Cell Marker）」です。VBA上では `Chr(13)`（キャリッジリターン）と `Chr(7)`（ベル文字）の2バイトで表現されます。これをそのまま文字列として抽出すると、ファイル名生成に失敗するか、テキストボックスや置換処理で予期せぬ改行・文字化けを引き起こします。

—

2. 実装コード：プロダクション対応のドキュメント生成エンジン

以下のコードは、アクティブ文書（または指定文書）内の表を解析し、行ごとのデータをテンプレートに差し込んで個別保存する完成スクリプトです。エラーハンドリング、パスの検証、ファイル名のサニタイズ（禁止文字置換）を網羅しています。

準備

1. マスタ文書（表を含む文書）：1行目にヘッダー、2行目以降にデータが存在する表を配置。
2. テンプレート文書（.dotx または .docx）：マスタのヘッダー名に対応するプレースホルダー（例：`{{氏名}}`、`{{金額}}`）を本文や表内に配置。

Option Explicit

‘ ==============================================================================
‘ 業務自動化エンジン: 表データ行の個別ドキュメント分割生成
‘ ==============================================================================
Public Sub BatchGenerateDocumentsFromTable()
Dim masterDoc As Document
Dim targetTable As Table
Dim templatePath As String
Dim outputDir As String

‘ パフォーマンス向上のためのUI抑止
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone

Set masterDoc = ActiveDocument

‘ 1. ガード節: 表の存在チェック
If masterDoc.Tables.Count = 0 Then
MsgBox “エラー: アクティブな文書内に表が見つかりません。”, vbCritical, “処理中断”
Exit Sub
End If

Set targetTable = masterDoc.Tables(1)

‘ 2. 環境パラメータの設定（実務では設定シートやダイアログから取得推奨）
templatePath = masterDoc.Path & “\Template.docx”
outputDir = masterDoc.Path & “\Output”

‘ テンプレート存在確認
If Dir(templatePath) = vbNullString Then
MsgBox “エラー: テンプレートファイルが存在しません。” & vbCrLf & templatePath, vbCritical, “処理中断”
Exit Sub
End If

‘ 出力フォルダの自動生成
EnsureDirectory outputDir

‘ 3. ヘッダー情報のキャッシュ（1行目をプレースホルダーキーとして取得）
Dim colCount As Long
colCount = targetTable.Columns.Count

Dim headers() As String
ReDim headers(1 To colCount)

Dim c As Long
For c = 1 To colCount
headers(c) = CleanCellText(targetTable.Cell(1, c).Range.Text)
Next c

‘ 4. 各行のループ処理（2行目以降がデータ部）
Dim rowCount As Long
rowCount = targetTable.Rows.Count

Dim r As Long
Dim generatedCount As Long
generatedCount = 0

For r = 2 To rowCount
Dim newDoc As Document
‘ テンプレートを基に新規インスタンスを起動
Set newDoc = Documents.Add(Template:=templatePath, NewTemplate:=False, DocumentType:=wdNewBlankDocument)

‘ テンプレート内のプレースホルダーを一括置換
For c = 1 To colCount
Dim placeholder As String
Dim cellValue As String

placeholder = “{{” & headers(c) & “}}”
cellValue = CleanCellText(targetTable.Cell(r, c).Range.Text)

‘ ドキュメント全体（StoryRanges）のテキスト置換を実行
ReplacePlaceholderFast newDoc, placeholder, cellValue
Next c

‘ ファイル名に使用するキー列（例: 1列目を識別子とする）
Dim idKey As String
idKey = CleanCellText(targetTable.Cell(r, 1).Range.Text)
idKey = SanitizeFileName(idKey)

If idKey = vbNullString Then idKey = “Doc_Row_” & CStr(r)

Dim saveFilePath As String
saveFilePath = outputDir & “\” & idKey & “_” & Format(Now, “yyyymmdd”) & “.docx”

‘ ドキュメント保存と確実なメモリ解放
newDoc.SaveAs2 FileName:=saveFilePath, FileFormat:=wdFormatXMLDocument
newDoc.Close SaveChanges:=wdDoNotSaveChanges
Set newDoc = Nothing

generatedCount = generatedCount + 1
Next r

‘ 正常終了処理
Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll
MsgBox “処理が完了しました。” & vbCrLf & “生成件数: ” & generatedCount & ” 件”, vbInformation, “成功”
Exit Sub

ErrorHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll

‘ 例外発生時に孤立した新規Documentが残っていれば安全に閉じる
If Not newDoc Is Nothing Then
newDoc.Close SaveChanges:=wdDoNotSaveChanges
Set newDoc = Nothing
End If

MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical, “システムエラー”
End Sub

‘ ==============================================================================
‘ 補助関数: セル内テキストから制御文字（Chr(13) & Chr(7)）を完全に剥ぎ取る
‘ ==============================================================================
Private Function CleanCellText(ByVal text As String) As String
‘ Wordのセル末尾は Chr(13) & Chr(7) で終わるため、後方2バイトを除外
If Len(text) >= 2 Then
If Right$(text, 2) = Chr(13) & Chr(7) Then
text = Left$(text, Len(text) – 2)
End If
End If
CleanCellText = Trim$(text)
End Function

‘ ==============================================================================
‘ 補助関数: 高速プレースホルダー一括置換（本文およびヘッダー・フッター全走査）
‘ ==============================================================================
Private Sub ReplacePlaceholderFast(ByRef doc As Document, ByVal findText As String, ByVal replaceText As String)
Dim rngStory As Range

‘ すべてのStoryType（本文、ヘッダー、テキストボックス等）を網羅
For Each rngStory In doc.StoryRanges
Do
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = findText
.Replacement.text = replaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.Execute Replace:=wdReplaceAll
End With
Set rngStory = rngStory.NextStoryRange
Loop While Not (rngStory Is Nothing)
Next rngStory
End Sub

‘ ==============================================================================
‘ 補助関数: OSファイル名禁止文字のサニタイズ
‘ ==============================================================================
Private Function SanitizeFileName(ByVal fileName As String) As String
Dim invalidChars As Variant
Dim i As Long

invalidChars = Array(“\”, “/”, “:”, “”, “?”, “”””, “<", ">“, “|”, vbTab, vbCr, vbLf)
For i = LBound(invalidChars) To UBound(invalidChars)
fileName = Replace(fileName, invalidChars(i), “_”)
Next i

SanitizeFileName = Trim$(fileName)
End Function

‘ ==============================================================================
‘ 補助関数: ディレクトリの存在確認と自動作成
‘ ==============================================================================
Private Sub EnsureDirectory(ByVal path As String)
If Dir(path, vbDirectory) = vbNullString Then
MkDir path
End If
End Sub

—

3. コード詳解：堅牢性を担保する設計ポイント

① `CleanCellText` による終端文字の除去

If Right$(text, 2) = Chr(13) & Chr(7) Then
text = Left$(text, Len(text) – 2)
End If

Word VBA初心者が必ずハマるのがここです。通常の文字列関数 `Replace(text, vbCr, “”)` だけでは `Chr(7)` が残留し、ファイル名に指定した瞬間に「実行時エラー 52: ファイル名または番号が不正です」が発生します。末尾の2文字を物理的に落とすのが最も安全かつ最速です。

② `StoryRanges` ループによる置換の完全性

For Each rngStory In doc.StoryRanges
Do
…
Set rngStory = rngStory.NextStoryRange
Loop While Not (rngStory Is Nothing)
Next rngStory

単に `doc.Content.Find` を呼ぶだけでは、ヘッダー・フッターやテキストボックス、シェイプ内の文字が置換されません。Wordドキュメントは複数の「ストーリー」で構成されているため、`StoryRanges` を走査し、さらに `NextStoryRange`（リンクされた枠）まで追跡するのがプロダクション設計の必須要件です。

③ 徹底したCOMオブジェクト解放とリソース管理

ループの内部で：

newDoc.Close SaveChanges:=wdDoNotSaveChanges
Set newDoc = Nothing

を行っています。WordはExcel以上にバックグラウンドでのメモリ消費が激しいアプリケーションです。`Set newDoc = Nothing` を明示的に呼び出さないと、ガベージコレクションが追いつかず、WINWORD.EXEのプライベートバイトが増加し続け、やがてクラッシュします。エラーハンドラ内でも同様に `newDoc` のクリーンアップを行っている点に注目してください。

—

まとめ：真の自動化は「保守のコスト」を下げる

表のデータを1行ずつ分割保存する処理は、仕様自体はシンプルです。しかし、

• セル内部の特殊なバイナリ仕様を理解しているか
• OSのファイルシステム要件（禁則文字）に対応できているか
• 大量処理時にプロセスが耐えうるリソース管理を行っているか

これらをクリアして初めて、エンドユーザーが安心して運用できる「業務システム」へと昇華します。

今回のスクリプトをベースに、出力フォーマットをPDF（`ExportAsFixedFormat`）へ変更する、あるいはOutlookオブジェクトと連携させてそのまま下書きメールを作成するなど、要件に合わせて拡張してみてください。堅牢な基盤さえあれば、どのような機能追加も極めて安全に行うことができます。