こんにちは！Word VBAの世界へようこそ。
これまで、マクロの記録から一歩踏み出し、 `Selection.Find` や `Range.Find` を使って文書内の文字列をガリガリ検索・置換してきたことと思います。
「数千ページの仕様書やマニュアルの置換を実行したら、終わるまでにコーヒーが何杯も飲めてしまう…」
「画面が激しくチラつきながら、1行ずつカーソルが動いていくのをただ祈るように見守っている…」
そんな地獄のような待ち時間に、絶望した経験はありませんか？
もしあなたがその壁にぶつかっているなら、おめでとうございます。あなたは今、Word VBAの「本当の限界と、その先の扉」の前に立っています。
今回は、Wordのオブジェクトモデル（画面上の文書や段落を一つずつ操作する仕組み）を完全にバイパスし、Wordファイルの実体であるXMLを直接DOM（Document Object Model）で高速料理するという、極限のスピードを誇る禁断のアーキテクチャを伝授します。
ここをクリアすれば、Word VBAの景色がガラリと変わりますよ。さあ、一緒に扉を開けましょう！
—
なぜ従来の `Find` / `Replace` は遅いのか？
私たちが普段使っている `.Find.Execute` は、裏側でWordの「レンダリングエンジン」や「UIスレッド」と密接に連携しています。
画面上に変更を反映させ、アンドゥ（履歴）のスタックを積み上げ、レイアウトを再計算しながら処理を進めるため、文書が分厚くなればなるほど、オセロの角を取られたかのように急激に処理が重くなります。
究極の発想の転換：Wordファイルは「ただのZIP」である
実は、拡張子が `.docx` のファイルは、中身がただのZIPアーカイブです。解凍してみると、中には `word/document.xml` という巨大なXMLファイルが入っています。
つまり、こういうことです。
1. Wordファイルをプログラムから「ZIP」として解凍する
2. 中身のXMLテキストに対し、高速な文字列置換やDOM操作を行う
3. 再びZIPに圧縮して `.docx` に戻す
Wordの画面を一度も立ち上げず、メモリ上で純粋なテキスト処理だけを完結させる。これこそが、数万ページをも一瞬で飲み込む「XML直接操作による高速置換」の正体です。
—
準備するもの：VBAからXMLをどう扱うか？
「XMLの操作なんて難しそう…」と思いましたか？
安心してください。Windows環境のVBAには、強力なXMLパーサーである `MSXML2.DOMDocument` が標準で備わっています。これを使えば、HTMLやXMLの構造を壊さず、正確に目的のタグやテキストだけを狙い撃ちできます。
今回は、最も実用的かつ安全なアプローチとして、「ADODB.Stream」によるファイルの読み書き と 「Shell.Application」によるZIPの解凍・圧縮、そして 「VBAの文字列置換（または正規表現）」 を組み合わせた、現場で即戦力になるコードを組み上げていきます。
—
実装編：超高速XML置換エンジンの全コード
以下のコードは、指定したWordファイル（.docx）を一時フォルダに展開し、中の `document.xml` を書き換えてから再圧縮するプロシージャです。
※実行前に、VBEのメニューから [ツール] ＞ [参照設定] で 「Microsoft XML, v6.0」 にチェックを入れておいてください（後期バインディングでも動きますが、今回は分かりやすさ重視で直叩きします）。
Option Explicit
‘ =========================================================================
‘ テーマ: Word文書をXML形式で直接操作し、限界突破の高速置換を行うエンジン
‘ 概要 : オブジェクトモデルを使わず、ZIP展開→XMLテキスト置換→再圧縮を行う
‘ =========================================================================
Public Sub ExecuteUltraFastXmlReplace()
Dim targetPath As String
targetPath = ThisWorkbook.Path & “\TestDocument.docx” ‘ 処理対象のパス（適宜変更してください）
If Dir(targetPath) = “” Then
MsgBox “対象のファイルが見つかりません: ” & targetPath, vbCritical
Exit Sub
End Sub
Dim startTime As Single
startTime = Timer
‘ 1. 作業用一時フォルダのパスを生成
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
Dim tempDir As String
tempDir = fso.GetSpecialFolder(2) & “\” & fso.GetNewGuid()
fso.CreateFolder tempDir
On Error GoTo ErrorHandler
‘ 2. .docx (実体はZIP) を一時フォルダに展開
UnzipFile targetPath, tempDir
‘ 3. word/document.xml を読み込み、高速置換を実行
Dim xmlPath As String
xmlPath = tempDir & “\word\document.xml”
Dim xmlContent As String
xmlContent = ReadTextFile(xmlPath, “utf-8”)
‘ — ここで置換処理を実行 —
‘ 例：「旧製品名」を「新・超高速製品名」に一括置換
Dim beforeStr As String, afterStr As String
beforeStr = “旧製品名”
afterStr = “新・超高速製品名”
‘ WordのXML構造では、テキストがタグで分割されていることがあるため注意が必要ですが、
‘ 単純なキーワードであればここで一気に置換できます。
xmlContent = Replace(xmlContent, beforeStr, afterStr)
‘ —————————-
‘ 4. 置換後のXMLを上書き保存
WriteTextFile xmlPath, xmlContent, “utf-8”
‘ 5. 再びZIP（.docx）に圧縮して元ファイルを上書き
‘ 一旦元のファイルを削除、または別名保存
Dim backupPath As String
backupPath = targetPath & “.bak”
If fso.FileExists(backupPath) Then fso.DeleteFile backupPath
fso.CopyFile targetPath, backupPath
ZipFile tempDir, targetPath
‘ 6. 後片付け
fso.DeleteFolder tempDir, True
Set fso = Nothing
MsgBox “処理が完了しました！” & vbCrLf & _
“実行時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, vbInformation
Exit Sub
ErrorHandler:
MsgBox “エラーが発生しました: ” & Err.Description, vbCritical
If Not fso Is Nothing Then
If fso.FolderExists(tempDir) Then fso.DeleteFolder tempDir, True
End If
End Sub
‘ =========================================================================
‘ 補助関数：UTF-8対応のテキスト読み込み
‘ =========================================================================
Private Function ReadTextFile(ByVal filePath As String, ByVal charset As String) As String
Dim stream As Object
Set stream = CreateObject(“ADODB.Stream”)
With stream
.Type = 2 ‘ adTypeText
.charset = charset
.Open
.LoadFromFile filePath
ReadTextFile = .ReadText
.Close
End Function
Set stream = Nothing
End Function
‘ =========================================================================
‘ 補助関数：UTF-8（BOMなし推奨）でのテキスト書き出し
‘ =========================================================================
Private Sub WriteTextFile(ByVal filePath As String, ByVal content As String, ByVal charset As String)
Dim stream As Object
Set stream = CreateObject(“ADODB.Stream”)
With stream
.Type = 2 ‘ adTypeText
.charset = charset
.Open
.WriteText content
.SaveToFile filePath, 2 ‘ adSaveCreateOverWrite
.Close
End Sub
Set stream = Nothing
End Sub
‘ =========================================================================
‘ 補助関数：ZIP解凍（Shell.Applicationを使用）
‘ =========================================================================
Private Sub UnzipFile(ByVal zipFilePath As String, ByVal destFolder As String)
Dim sa As Object
Set sa = CreateObject(“Shell.Application”)
‘ 展開先フォルダの作成確認
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(destFolder) Then fso.CreateFolder destFolder
‘ Shellを使ってコピー（解凍）
sa.NameSpace(destFolder).CopyHere sa.NameSpace(zipFilePath).Items, 4 + 16
Set sa = Nothing
Set fso = Nothing
End Sub
‘ =========================================================================
‘ 補助関数：ZIP圧縮（空のZIPを作ってから中に放り込む）
‘ =========================================================================
Private Sub ZipFile(ByVal srcFolder As String, ByVal zipFilePath As String)
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(zipFilePath) Then fso.DeleteFile zipFilePath
‘ 空のZIPファイル（ヘッダのみ）を作成
Dim fs As Object
Set fs = fso.CreateTextFile(zipFilePath, True)
fs.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
fs.Close
Set fs = Nothing
Dim sa As Object
Set sa = CreateObject(“Shell.Application”)
Dim zipNamespace As Object
Set zipNamespace = sa.NameSpace(zipFilePath)
‘ フォルダ内の全アイテムをZIPにコピー
Dim srcNamespace As Object
Set srcNamespace = sa.NameSpace(srcFolder)
zipNamespace.CopyHere srcNamespace.Items, 4 + 16
‘ 圧縮処理が完了するまで少し待機（非同期対策）
Dim startTime As Single
startTime = Timer
Do While zipNamespace.Items.Count < srcNamespace.Items.Count
DoEvents
If Timer - startTime > 10 Then Exit Do ‘ 10秒タイムアウト
Loop
Set sa = Nothing
Set fso = Nothing
End Sub
—
ここで陥りやすい「最大の罠」と回避策
この手法は圧倒的なスピードを誇る反面、Wordの内部構造を直接触るがゆえの「罠」が存在します。ここを理解しておかないと、「置換はできたけれど、Wordで開いたらファイルが破損していると言われた…」という悪夢を見ることになります。
1. 文字列がXMLのタグで分断されている問題
WordのXML（`document.xml`）では、ユーザーが続けて入力した文字列であっても、途中でフォントが変わったり、太字が適用されたりすると、以下のようにXMLタグで分断されます。
この状態のとき、単純に `Replace(xmlContent, “旧製品名”, “新・超高速製品名”)` を実行しても、`` や `
💡 解決の知見
完全な置換を行いたい場合は、単純な文字列置換ではなく、一度 `MSXML2.DOMDocument` に読み込ませ、XPathを使って `
まずは今回紹介した「単純なキーワード置換」でカバーできる範囲（フォーマット装飾のない定型テキスト等）から試してみるのが安全です。
2. 文字コード（UTF-8）のBOMと改行コード
WordのXMLは `UTF-8` でエンコードされています。先ほどのコードで `ADODB.Stream` を使っているのは、このUTF-8の読み書きを正確に行うためです。
もしここをShift-JISやBOM付きUTF-8などで誤って保存してしまうと、Wordがファイルを読み込めなくなるので注意してください。
—
先輩エンジニアからのエール
お疲れ様でした！今回はあえてWord VBAの常識をひっくり返す「XML直接操作」というハイエンドな手法をご紹介しました。
「マクロの記録」から始まり、オブジェクトのループ処理に絶望し、そしてこのファイル構造の理解へと辿り着いたあなたなら、もう初学者ではありません立派な自動化アーキテクトです。
業務の現場で「数万ページのドキュメントを一括変換しなければならない」という理不尽な要件に出会ったとき、この手法を思い出してください。きっと、周囲をあっと言わせる解決策を提示できるはずです。
あなたのVBAライフが、よりスピーディで知的なものになりますように。それでは、また次の極限の世界でお会いしましょう！
