【対話型バッチ処理】PowerPoint VBAでメモリリークを防ぐ複数フォルダ一括処理フレームワークの極意
開発現場でよくある要望だ。「共有サーバーにある複数のフォルダ階層からPowerPointファイルを探し出し、一括で処理（デザイン統一、メタデータ更新、PDF変換など）したい」。
しかし、これを素直なコードで実装すると、数個のファイルを処理したあたりでPowerPointが突如フリーズしたり、デスクトップヒープが枯渇して強制終了したりする。原因は明確だ。オブジェクトの解放漏れと、`Application`インスタンスの肥大化である。
今回は、実務の現場で絶対に破綻しない、`Application.FileDialog`を活用した「対話型マルチフォルダ・バッチ処理フレームワーク」の全貌を授ける。
—
1. なぜ「普通のVBAコード」は大規模バッチで死ぬのか
多くのプログラマブルでないマクロは、以下のようなアンチパターンを孕んでいる。
1. プレゼンテーションの閉じ忘れ・参照の放置
`Set pres = Presentations.Open(…)` を実行した後、適切な `Close` と変数への `Nothing` 代入を行わないと、COMコンテナ内にゾンビプロセスが残り続ける。
2. `Application` オブジェクトの過剰な酷使
数千ファイルの処理中、画面描画（ScreenUpdating）やイベント（EnableEvents）を制御せず、さらにウィンドウをアクティブにし続けることで、GDIリソースが徐々にリークする。
3. エラーハンドリングの欠如
パスワード保護されたファイルや、破損した `.pptx` に遭遇した瞬間、バッチ全体が停止する。
これを解決するためには、「明確なライフサイクル管理」と「トランザクション的なエラー耐性」を持ったフレームワーク構造が不可欠となる。
—
2. 堅牢なバッチ処理フレームワークの設計思想
今回構築するフレームワークのアーキテクチャは以下の通りだ。
- UI層 (`Application.FileDialog`): ユーザーに複数フォルダを選択させる。単一フォルダだけでなく、複数階層を許容する柔軟性を持たせる。
- 探索層 (FileSystemObject): 選択されたフォルダ群を再帰的に走査し、対象となる `.pptx` / `.ppt` の絶対パスリストを生成する。
- 実行層 (Core Execution Loop): 1ファイルごとに「開く $\rightarrow$ 処理 $\rightarrow$ 保存 $\rightarrow$ 閉じる」を完全に独立させ、例外が発生しても次のファイルへ安全に処理を継承する。
—
3. プロダクションコード：対話型一括処理モジュール
以下のコードを標準モジュールにそのまま貼り付けてほしい。実務で即座に使える、極限まで最適化されたプロダクションコードだ。
Option Explicit
‘ ==============================================================================
‘ 処理名: 複数フォルダ対話型バッチ処理フレームワーク
‘ 概要: ユーザーが選択した複数のフォルダ内からPowerPointファイルを再帰的に収集し、
‘ メモリリークを完全に防ぎながら安全に一括処理を実行する。
‘ ==============================================================================
Public Sub ExecuteBatchPresentationProcessor()
Dim fso As Object
Dim selectedFolders As Collection
Dim targetFiles As Collection
Dim startTime As Double
startTime = Timer
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 1. UI層: ユーザーに対話的に複数フォルダを選択させる
Set selectedFolders = PromptForMultipleFolders()
If selectedFolders Is Nothing Then
MsgBox “処理がキャンセルされました。”, vbInformation, “バッチ処理中断”
Exit Sub
End If
‘ 2. 探索層: 対象ファイルの収集
Set targetFiles = CollectTargetFiles(fso, selectedFolders)
If targetFiles.Count = 0 Then
MsgBox “処理対象となるPowerPointファイルが見つかりませんでした。”, vbExclamation, “対象なし”
Exit Sub
End If
‘ 3. 最適化設定: パフォーマンス向上とメモリ保護のため描画等を停止
Call ToggleApplicationEnvironment(False)
Dim processedCount As Long
Dim errorCount As Long
processedCount = 0
errorCount = 0
‘ 4. 実行層: メモリを保護しながら順次処理
Dim filePath As Variant
For Each filePath In targetFiles
If ProcessSinglePresentation(CStr(filePath)) Then
processedCount = processedCount + 1
Else
errorCount = errorCount + 1
End If
Next filePath
‘ 5. 環境復元
Call ToggleApplicationEnvironment(True)
‘ 完了レポート
MsgBox “バッチ処理が完了しました。” & vbCrLf & _
“———————————-” & vbCrLf & _
“成功: ” & processedCount & ” 件” & vbCrLf & _
“失敗: ” & errorCount & ” 件” & vbCrLf & _
“所要時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “処理完了”
‘ オブジェクト解放
Set targetFiles = Nothing
Set selectedFolders = Nothing
Set fso = Nothing
End Sub
‘ ——————————————————————————
‘ 複数フォルダ選択ダイアログの制御
‘ ——————————————————————————
Private Function PromptForMultipleFolders() As Collection
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim folders As New Collection
‘ msoFileDialogFolderPickerを使用
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = “一括処理を行うルートフォルダを選択してください（複数選択可）”
fd.AllowMultiSelect = True
If fd.Show = -1 Then
For Each vrtSelectedItem In fd.SelectedItems
folders.Add CStr(vrtSelectedItem)
Next vrtSelectedItem
Set PromptForMultipleFolders = folders
Else
Set PromptForMultipleFolders = Nothing
End If
End Function
‘ ——————————————————————————
‘ 再帰的なファイル収集ロジック
‘ ——————————————————————————
Private Function CollectTargetFiles(fso As Object, folders As Collection) As Collection
Dim files As New Collection
Dim folderPath As Variant
For Each folderPath in folders
RecursiveFileSearch fso, fso.GetFolder(folderPath), files
Next folderPath
Set CollectTargetFiles = files
End Function
Private Sub RecursiveFileSearch(fso As Object, subFolder As Object, files As Collection)
Dim fileItem As Object
Dim nestedFolder As Object
Dim ext As String
‘ 現在のフォルダ内のファイルをスキャン
For Each fileItem In subFolder.Files
ext = LCase(fso.GetExtensionName(fileItem.Path))
If ext = “pptx” Or ext = “ppt” Or ext = “pptm” Then
‘ 一時ファイル（~$で始まるもの）は除外
If Left(fso.GetFileName(fileItem.Path), 2) <> “~$” Then
files.Add fileItem.Path
End If
End If
Next fileItem
‘ サブフォルダを再帰的にスキャン
For Each nestedFolder In subFolder.SubFolders
RecursiveFileSearch fso, nestedFolder, files
Next nestedFolder
End Sub
‘ ——————————————————————————
‘ アプリケーション環境の最適化（画面描画・イベントの抑制）
‘ ——————————————————————————
Private Sub ToggleApplicationEnvironment(ByVal state As Boolean)
On Error Resume Next
With Application
.ScreenUpdating = state
.DisplayAlerts = (Not state) ‘ 警告ダイアログの抑制
End With
On Error GoTo 0
End Sub
‘ ——————————————————————————
‘ 【最重要】単一ファイルの安全な処理とメモリ解放ロジック
‘ ——————————————————————————
Private Function ProcessSinglePresentation(ByVal filePath As String) As Boolean
Dim pres As Presentation
On Error GoTo ErrorHandler
‘ 読み取り専用で開くことで元ファイルを保護し、競合を防ぐ
‘ WithWindow:=msoFalse を指定することで、UIウィンドウを表示せずメモリ上で処理し軽量化する
Set pres = Presentations.Open(FileName:=filePath, _
ReadOnly:=msoTrue, _
Untitled:=msoFalse, _
WithWindow:=msoFalse)
‘ ==========================================================================
‘ 【ここに実際の業務ロジックを記述する】
‘ 例: 全スライドの特定シェイプのフォント変更、メタデータ付与 など
‘ ==========================================================================
Dim sld As Slide
For Each sld In pres.Slides
‘ サンプルとしてのダミー処理（何もしない、またはログ出力など）
DoEvents
Next sld
‘ 変更を保存する場合（ReadOnlyを解除して別名保存等する場合の設計）
‘ 今回は読み取り専用のため、保存せずにクローズ
pres.Close
Set pres = Nothing
ProcessSinglePresentation = True
Exit Function
ErrorHandler:
‘ 異常発生時のクリーンアップ（メモリリークの防止）
On Error Resume Next
If Not pres Is Nothing Then
pres.Close
Set pres = Nothing
End If
‘ エラーログの出力（イミディエイトウィンドウ）
Debug.Print “[Error] 処理失敗: ” & filePath & ” (Error ” & Err.Number & “: ” & Err.Description & “)”
ProcessSinglePresentation = False
On Error GoTo 0
End Function
—
4. チーフアーキテクトが解説する「実装の急所」
上記のコードにおいて、プロフェッショナルとして絶対に譲れない設計ポイントを解説する。
① `WithWindow:=msoFalse` による圧倒的な軽量化
通常、`Presentations.Open` を行うと PowerPoint のウィンドウが背後でポコポコと立ち上がり、GDIやCPUリソースを激しく消費する。
`WithWindow:=msoFalse` を指定することで、GUIを描画せずにメモリ（ヘッドレス）空間上でオブジェクトを操作できる。 これにより、処理速度が数倍に跳ね上がり、描画関連のクラッシュが劇的に減少する。
② 確実なスコープと `Set pres = Nothing`
VBAのCOMオブジェクト管理は非常に気まぐれだ。エラー発生時に変数を解放し損ねると、インスタンスがメモリに残留する。
`ProcessSinglePresentation` 関数内の `ErrorHandler` ラベルを見てほしい。ここでは例外をキャッチした後、必ず `pres.Close` を試行し、直後に `Set pres = Nothing` で参照カウントを確実にデクリメントしている。これが長期稼働するバッチ処理の寿命を延ばす。
③ 一時ファイル（`~$`）の除外フィルタ
ネットワークドライブやOneDrive同期フォルダをスキャンすると、Microsoft Officeが生成するロックファイル（例: `~$Presentation.pptx`）が混入する。これをそのまま `Presentations.Open` しようとすると確実にエラー（ファイル形式が無効等）になる。
ファイル名先頭の `~$` を厳密に弾くフィルタリング処理が、バッチの安定稼働を担保する。
—
5. データベースや外部システム連携への拡張性
このフレームワークは、単なるファイルのインプレース加工だけに留まらない。
例えば、処理したファイルのメタデータ（スライド数、最終更新者、使用フォント一覧など）を SQLite や SQL Server、あるいは Excelの監査ログシート に蓄積したい場合、`ProcessSinglePresentation` 内に以下のような拡張をシームレスに行うことができる。
‘ 拡張例: 処理成功後にメタデータを外部DBやログに書き出す
Sub WriteLogToDatabase(filePath As String, pres As Presentation)
‘ ADODB Connection等を用いたデータベース連携処理
‘ Dim conn As Object
‘ Set conn = CreateObject(“ADODB.Connection”)
‘ …
End Sub
UI層で選択されたフォルダ群を起点に、安全なイテレーションを回すこの骨組みさえあれば、どんなに複雑なドキュメントエンジニアリングの要求であっても、破綻することなく実装を完遂できる。
現場のインフラを守り、定時退社を勝ち取るための堅牢なコードを、ぜひあなたのソリューションに組み込んでほしい。
