【実務・中級編】【中級者】FSO(FileSystemObject)を駆使し、指定フォルダ内のサブフォルダ構造を完全維持したまま、すべてのPPTXをPDFに変換・配置する階層維持エクスポートマクロ – PowerPoint VBA解析バイブル

スポンサーリンク

【PowerPoint VBA極限活用】FSO再帰処理でサブフォルダ構造を完全に維持したままPPTXをPDFへ一括爆速変換するアーキテクチャ

開発現場でよくある絶望的な要望の一つに、「共有サーバーの奥深くにある、何階層にも入れ子になった数百個のPowerPointファイルを、元のフォルダ構造を1ミリも崩さず、そのままPDFに変換して配置してほしい」というものがある。

これを手作業でやれば、エクスプローラーを行ったり来たりし、プレゼンテーションを開いては「名前を付けて保存」を繰り返すという、エンジニアの尊い時間をドブに捨てる苦行と化す。もちろん、フラットな出力先フォルダにすべてをブチ込むような手抜きスクリプトでは、後からどのファイルがどの文脈の資料だったかすら分からなくなる。

今回は、FileSystemObject(FSO)の再帰処理(Recursion)を駆使し、元フォルダのツリー構造を完璧に複製しながらPPTXをPDFへ一括変換する、プロダクション品質のVBAマクロを授けよう。

—

1. 現場のエンジニアが陥る「3つの罠」と設計思想

素人が書いたVBAコードは、実務の巨大なファイル群や汚いディレクトリ構造を目の前にした途端、あっさりクラッシュする。私たちはプロのアーキテクトとして、以下の3つの罠をあらかじめコードでねじ伏せておかなければならない。

罠1: Dir関数による再帰の限界とFSOの選択

標準の `Dir` 関数は、多重ループや再帰呼び出しの中で状態を保持できず、ネストが深くなると簡単に暴走する。フォルダ操作の絶対王者は `Scripting.FileSystemObject` である。遅延バインディングではなく、早期バインディング(参照設定)を前提とした堅牢なオブジェクト指向アプローチをとる。

罠2: PowerPointの裏側で起きるメモリリークとダイアログの呪い

VBAからPPTXをPDF化する際、`Presentation.SaveAs` や `Export` を雑にループさせると、裏でPowerPointのプロセスやCOMオブジェクトが解放されず、メモリリークを起こして途中で固まる。
さらに、ファイルが破損している場合やパスワード保護されている場合、「リンクが更新できません」「読み取り専用です」といったダイアログがポップアップし、バッチ処理が完全にフリーズする。これをコード側で完全沈黙(サイレント化)させなければならない。

罠3: パス文字長制限(MAX_PATH / 260文字)の回避

Windowsのレガシーな制限である260文字を超えるパス構造を持つフォルダが組織内には確実に存在する。FSOでこれを叩くと「パスが見つかりません」という致命的なエラーで落ちる。この対策も含めた設計が必要だ。

—

2. プロダクションコード

以下のコードは、エラーハンドリング、画面描画の完全停止、COMの適切な解放、そして再帰的なフォルダ構造の完全維持を実装した、実戦投入可能な完成版である。

前提条件(参照設定)

VBAエディタのメニューから [ツール] > [参照設定] を開き、以下にチェックを入れること。
1. Microsoft Scripting Runtime (FSO用)
2. Microsoft PowerPoint 16.0 Object Library (バージョンは環境に合わせて調整)

モジュールコード

Option Explicit

‘ ==============================================================================
‘ 処理名: フォルダ構造完全維持・PPTX一括PDF変換エンジン
‘ 概要 : 指定されたルートフォルダを再帰的に探索し、サブフォルダ構造を複製しながら
‘ 配下のすべてのPPTXファイルをPDFに変換して出力する。
‘ ==============================================================================
Public Sub ExportPptxToPdfRecursive()
‘ 1. 定数定義
Const SOURCE_DIR As String = “C:\Work\PptxSource” ‘ 変換元のルートフォルダ
Const DEST_DIR As String = “C:\Work\PdfOutput” ‘ 変換先のルートフォルダ

‘ 2. FSOの初期化
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject

‘ 3. 事前バリデーション
If Not fso.FolderExists(SOURCE_DIR) Then
MsgBox “変換元フォルダが存在しません。” & vbCrLf & SOURCE_DIR, vbCritical, “パス異常”
Exit Sub
End If

‘ 4. パフォーマンスと安定性のための環境最適化
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Interactive = False
End With

Dim startTime As Double
startTime = Timer

On Error GoTo ErrorHandler

‘ 5. 再帰処理の実行
Dim processedCount As Long
processedCount = 0

Call ProcessFolder(fso, fso.GetFolder(SOURCE_DIR), SOURCE_DIR, DEST_DIR, processedCount)

‘ 6. 完了通知
Dim elapsedTime As Double
elapsedTime = Timer – startTime

MsgBox “PDF一括変換が完了しました。” & vbCrLf & _
“処理ファイル数: ” & processedCount & ” 件” & vbCrLf & _
“処理時間: ” & Format(elapsedTime / 60, “0.0”) & ” 分”, _
vbInformation, “処理成功”

CleanUp:
‘ 7. 環境の復元(必ず実行)
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Interactive = True
End With
Exit Sub

ErrorHandler:
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & Err.Number & vbCrLf & _
“詳細: ” & Err.Description, vbCritical, “致命的エラー”
Resume CleanUp
End Sub

‘ ==============================================================================
‘ 内部関数: フォルダの再帰探索とミラーリング・変換処理
‘ ==============================================================================
Private Sub ProcessFolder(ByRef fso As Scripting.FileSystemObject, _
ByRef currentFolder As Scripting.Folder, _
ByRef rootSource As String, _
ByRef rootDest As String, _
ByRef counter As Long)

Dim subFolder As Scripting.Folder
Dim file As Scripting.File
Dim targetDestPath As String

‘ 1. 出力側に対応するフォルダパスを算出・生成
‘ 例: C:\Work\PptxSource\A\B 側のパスから、ルート部分を置換して出力先を構築
targetDestPath = Replace(currentFolder.Path, rootSource, rootDest, 1, 1, vbTextCompare)

If Not fso.FolderExists(targetDestPath) Then
fso.CreateFolder targetDestPath
End If

‘ 2. 現在のフォルダ内の全ファイルを走査
For Each file In currentFolder.Files
‘ 拡張子が .pptx (または .ppt) のみをターゲットにする(一時ファイル “~$” は除外)
If IsTargetPptx(file.Name) Then
Call ConvertToPdf(file.Path, targetDestPath, fso)
counter = counter + 1
End If
Next file

‘ 3. サブフォルダを再帰的に探索
For Each subFolder In currentFolder.SubFolders
Call ProcessFolder(fso, subFolder, rootSource, rootDest, counter)
Next subFolder

End Sub

‘ ==============================================================================
‘ 内部関数: 対象ファイル判定(一時ファイルや非PPTXの弾き落とし)
‘ ==============================================================================
Private Function IsTargetPptx(ByVal fileName As String) As Boolean
‘ Officeの編集中に生成される一時ファイル(“~$”)を完全に無視する
If Left(fileName, 2) = “~$” Then
IsTargetPptx = False
Exit Function
End If

Dim ext As String
ext = LCase(Mid(fileName, InStrRev(fileName, “.”) + 1))

If ext = “pptx” Or ext = “ppt” Or ext = “pptm” Then
IsTargetPptx = True
Else
IsTargetPptx = False
End If
End Function

‘ ==============================================================================
‘ 内部関数: 単一ファイルのPDF変換コアロジック
‘ ==============================================================================
Private Sub ConvertToPdf(ByVal sourceFilePath As String, _
ByVal destFolderPath As String, _
ByRef fso As Scripting.FileSystemObject)

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim baseName As String
Dim outputPdfPath As String

‘ ファイル名から拡張子を除いたベース名を取得
baseName = fso.GetBaseName(sourceFilePath)
outputPdfPath = fso.BuildPath(destFolderPath, baseName & “.pdf”)

‘ すでに同名のPDFが存在する場合は上書き(またはスキップ設計にすることも可能)
If fso.FileExists(outputPdfPath) Then
fso.DeleteFile outputPdfPath, True
End If

Set pptApp = Application ‘ 実行中のPowerPointインスタンスを借用

On Error GoTo ConvError
‘ ウィンドウを表示させずにファイルを開く(ReadOnly, Untitled, WithWindowすべてFalseが肝)
Set pptPres = pptApp.Presentations.Open(FileName:=sourceFilePath, _
ReadOnly:=msoTrue, _
Untitled:=msoFalse, _
WithWindow:=msoFalse)

‘ PDFとしてエクスポート(ppSaveAsPDF = 32)
pptPres.SaveAs FileName:=outputPdfPath, _
FileFormat:=ppSaveAsPDF

pptPres.Close
Set pptPres = Nothing
Exit Sub

ConvError:
‘ 1ファイルのエラーで全体のバッチを止めないための局所エラーハンドリング
Debug.Print “変換失敗: ” & sourceFilePath & ” | 理由: ” & Err.Description
If Not pptPres Is Nothing Then
pptPres.Close
Set pptPres = Nothing
End If
End Sub

—

3. このアーキテクチャが「プロの仕事」である理由

1. 完全な無人運用(Headless Operation)を実現
コード内の `Presentations.Open` において、`WithWindow:=msoFalse` を指定し、さらに `Application.ScreenUpdating = False` を組み合わせることで、画面の書き換えやプレゼンテーションのウインドウ表示を一切行わずにバックグラウンドで高速処理する。これにより、何百個ものファイルが開いては閉じるという視覚的ストレスと、それに伴う描画オーバーヘッドを完全に排除している。
2. 一時ファイル(`~$`)のスマートなスキップ
ネットワーク共有フォルダでこれをやると、誰かが開きっぱなしにしているファイルのロックファイル(`~$filename.pptx`)に当たってマクロが死ぬ。`IsTargetPptx` 関数内の `Left(fileName, 2) = “~$”` チェックにより、こうした実務上の「汚い現実」を華麗にスルーする。
3. エラーの局所化(Fault Isolation)
もし100冊のうち1冊だけパスワード保護されていたり、ファイルが破損していたりした場合、素人のコードならそこでスクリプト全体が停止する。しかし、上記の設計では `ConvertToPdf` 内に局所的な `On Error GoTo ConvError` を配備しているため、「壊れたファイルはログ(イミディエイトウインドウ)に吐いてスキップし、残りの99冊は完璧に変換を完了させる」という、実務で絶対に譲れない耐障害性を担保している。

—

4. チーフアーキテクトからの実践アドバイス

このマクロを実際に企業内の巨大なファイルサーバー(NASやSharePointの同期フォルダなど)で走らせる場合、次のポイントに注意してほしい。

  • ネットワーク遅延の考慮: ローカルPCではなくネットワークドライブ上のファイルを直接処理する場合、I/Oのボトルネックで速度が低下する。可能であれば、一度ローカルの作業用フォルダ(例: `C:\Work`)にフォルダごとツリーをコピーしてからマクロを走らせ、完了後に結果をサーバーへアップロードするパイプラインを組む方が、結果的にトータルの処理時間は短縮される。
  • PowerPointのバージョン差異: `ppSaveAsPDF` 定数は PowerPoint 2007 以降であれば標準で内蔵されているが、万が一古い環境や互換モードが絡む場合は、値である `32` を直接ハードコードしても動作する。

自動化とは、単に手作業を置き換えることではない。「起こり得る例外をすべて予測し、人が介入しなくても確実にゴールへ到達する仕組み」をコードの形に落とし込むことだ。このスクリプトをあなたの現場に導入し、無意味な単純作業からチームを解放してほしい。

タイトルとURLをコピーしました