【編集工数監査】PowerPointのメタデータから「総編集時間」を自動抽出・CSVロギングする極限のVBAアーキテクチャ
開発現場において、プロジェクトの進捗管理や工数算定は永遠の課題だ。特に、提案書や仕様書といったPowerPointドキュメントの作成において、「誰が、どれだけの時間をかけてその成果物を練り上げたのか」を定量的に把握することは、リソース最適化の観点から極めて価値が高い。
しかし、多くの現場では、担当者の記憶や手入力の工数管理表に頼っており、データが属人化し、正確性に欠けている。
ここに朗報がある。PowerPointは、ファイル内部に「総編集時間（Total Editing Time）」や「最終保存者」「作成日時」といったメタデータを、OSやOfficeの機能として暗黙的に、かつ極めて正確に記録し続けている。
今回は、PowerPoint VBAのオブジェクトモデルを深くハックし、`BuiltInDocumentProperties` からこれらのメタデータを安全かつ高速に抽出し、プロジェクト管理用のCSVログとして自動出力するプロダクションコードを伝授する。
—
1. なぜ「BuiltInDocumentProperties」の直接参照は危険なのか？
多くの初学者や、場当たり的なコードを書くプログラマーは、次のようなコードを書きがちだ。
‘ 【アンチパターン】エラーハンドリングを無視した愚直な実装
Dim totalTime As Long
totalTime = ActivePresentation.BuiltInDocumentProperties(“Total Editing Time”).Value
このアプローチが実務で必ず破綻する理由を、オブジェクトのライフサイクルと仕様の観点から解説しよう。
1. インデックスの罠: `BuiltInDocumentProperties` コレクションのプロパティ名は、Officeの表示言語（日本語版か英語版か）によって文字列キーが変わる場合がある。また、存在しないプロパティを文字列で直叩きすると、容赦なく「実行時エラー’5′: プロシージャの呼び出し、または引数が不正です」が発生する。
2. 型安全性の欠如: `Value` プロパティの返す型は `Variant` であり、ドキュメントのステータスや保存状態によっては空値（Null / Empty）や予期せぬ型が返り、後続の計算で型ミスマッチを引き起こす。
3. ファイルI/Oの競合: 複数人で共有しているネットワークドライブ上の `.pptx` を監査する場合、ファイルロックや排他制御を考慮しないと、VBAランタイムが沈黙する。
真にロジカルで堅牢なエンジニアは、「防御的プログラミング」と「安全な関数カプセル化」によってこれらのリスクを完全に無力化する。
—
2. 実務仕様：プロダクションコードの全体像
以下のVBAスクリプトは、指定したフォルダ内（またはアクティブなプレゼンテーション単体）のPowerPointファイルを走査し、メタデータを安全に抽出して、UTF-8（BOM付き）のCSVログとして出力するアーキテクチャである。
このコードは、エラーハンドリング、オブジェクトのクリーンアップ、型安全性を完全に担保している。
Option Explicit
‘ ==============================================================================
‘ ﾓジュール名: modAuditEditingTime
‘ 概要 : PowerPointの組み込みプロパティから編集工数を監査しCSV出力する
‘ 著者 : チーフアーキテクト
‘ ==============================================================================
Public Sub ExportPresentationAuditLog()
Dim targetFolder As String
Dim fso As Object
Dim folderObj As Object
Dim fileObj As Object
Dim csvPath As String
Dim fileNum As Integer
Dim processedCount As Long
‘ 1. 対象フォルダの指定（今回はアクティブドキュメントと同じ階層をデフォルトとする）
On Error Resume Next
targetFolder = ActivePresentation.Path
On Error GoTo 0
If targetFolder = “” Then
MsgBox “対象のプレゼンテーションが一度も保存されていません。先に保存してください。”, vbCritical, “監査中断”
Exit Sub
}
csvPath = targetFolder & “\Presentation_Audit_Log_” & Format(Now, “yyyymmdd_HHMMSS”) & “.csv”
‘ 2. FileSystemObjectの生成
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(targetFolder) Then
MsgBox “指定されたフォルダが存在しません: ” & targetFolder, vbCritical
Exit Sub
}
Set folderObj = fso.GetFolder(targetFolder)
‘ 3. CSVファイルのオープン (FileNumberの動的取得)
fileNum = FreeFile
Open csvPath For Output As #fileNum
‘ CSVヘッダーの書き込み
Print #fileNum, “FileName,TotalEditingTime_Min,SlideCount,LastSavedBy,CreationDate,LastSaveTime”
processedCount = 0
‘ 4. フォルダ内の全PowerPointファイルを走査
For Each fileObj In folderObj.Files
Dim ext As String
ext = LCase(fso.GetExtensionName(fileObj.Name))
‘ .pptx および .ppt のみを対象とする (一時ファイルを除外)
If (ext = “pptx” Or ext = “ppt”) And Not (Left(fileObj.Name, 2) = “~$”) Then
Dim pptPath As String
pptPath = fileObj.Path
‘ メタデータ抽出を実行してCSVに追記
Call WriteMetadataToCsv(pptPath, fileNum, fso)
processedCount = processedCount + 1
End If
Next fileObj
‘ 5. クローズ処理
Close #fileNum
‘ オブジェクト解放
Set fileObj = Nothing
Set folderObj = Nothing
Set fso = Nothing
MsgBox “監査ログの生成が完了しました。” & vbCrLf & _
“処理ファイル数: ” & processedCount & vbCrLf & _
“出力先: ” & csvPath, vbInformation, “監査完了”
End Sub
‘ ==============================================================================
‘ 内部関数: 個別のPowerPointファイルから安全にプロパティを抽出しCSVへ出力
‘ ==============================================================================
Private Sub WriteMetadataToCsv(ByVal filePath As String, ByVal fn As Integer, ByRef fso As Object)
Dim pptApp As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim fileName As String
‘ プロパティ変数
Dim editingTimeMin As Double
Dim slideCount As Long
Dim lastSavedBy As String
Dim creationDate As String
Dim lastSaveTime As String
fileName = fso.GetFileName(filePath)
‘ バックグラウンドでPowerPointインスタンスを起動（画面描画を抑制し高速化）
‘ ※既に起動しているインスタンスと競合させないため、新規App作成を推奨
Set pptApp = New PowerPoint.Application
On Error GoTo ErrorHandler
‘ 読み取り専用・ウィンドウ非表示でオープン（パフォーマンスの極限化）
Set pres = pptApp.Presentations.Open(FileName:=filePath, _
ReadOnly:=msoTrue, _
Untitled:=msoFalse, _
WithWindow:=msoFalse)
‘ — プロパティの安全な抽出 —
‘ 総編集時間 (PowerPointの内部値は「分」単位)
editingTimeMin = GetDocProperty(pres, “Total Editing Time”, 0)
‘ スライド総数
slideCount = pres.Slides.Count
‘ 最終保存者
lastSavedBy = GetDocProperty(pres, “Last Author”, “Unknown”)
‘ 作成日時
creationDate = GetDocProperty(pres, “Creation Date”, “”)
‘ 最終保存日時
lastSaveTime = GetDocProperty(pres, “Last Save Time”, “”)
‘ CSV行のフォーマット書き込み（カンマやダブルクォーテーションのエスケープを考慮）
Print #fn, EscapeCsv(fileName) & “,” & _
editingTimeMin & “,” & _
slideCount & “,” & _
EscapeCsv(lastSavedBy) & “,” & _
EscapeCsv(creationDate) & “,” & _
EscapeCsv(lastSaveTime)
CleanUp:
‘ オブジェクトの厳密なライフサイクル管理（メモリリーク防止）
On Error Resume Next
If Not pres Is Nothing Then pres.Close
If Not pptApp Is Nothing Then pptApp.Quit
Set pres = Nothing
Set pptApp = Nothing
Exit Sub
ErrorHandler:
‘ 破損ファイルやパスワード保護ファイルでクラッシュするのを防ぐ
Print #fn, EscapeCsv(fileName) & “,ERROR,ERROR,ERROR,ERROR,ERROR”
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 補助関数: BuiltInDocumentProperties から安全に値を取得するラッパー
‘ ==============================================================================
Private Function GetDocProperty(ByRef pres As PowerPoint.Presentation, ByVal propName As String, ByVal defaultValue As Variant) As Variant
On Error GoTo SafeExit
Dim val As Variant
val = pres.BuiltInDocumentProperties(propName).Value
If Is为空(val) Or IsNull(val) Then
GetDocProperty = defaultValue
Else
GetDocProperty = val
End If
Exit Function
SafeExit:
GetDocProperty = defaultValue
End Function
‘ ==============================================================================
‘ 補助関数: CSVのフォーマット崩れを防ぐためのエスケープ処理
‘ ==============================================================================
Private Function EscapeCsv(ByVal text As String) As String
If InStr(text, “,”) > 0 Or InStr(text, “”””) > 0 Or InStr(text, vbCr) > 0 Or InStr(text, vbLf) > 0 Then
EscapeCsv = “””” & Replace(text, “”””, “”””””) & “”””
Else
EscapeCsv = text
End If
End Function
—
3. アーキテクチャの要点：プロが仕込んだ3つの技術的特権
上記のコードには、単なる「動くコード」を超えた、現場のトラブルを防ぐための厳格な設計思想が組み込まれている。
① `WithWindow:=msoFalse` による圧倒的パフォーマンス
PowerPointマクロでファイルを連続処理する際、ウィンドウを表示（GUI描画）させたままだと、OSの描画処理がボトルネックになり、数秒〜数十秒の遅延が発生する。`Presentations.Open` の引数で `WithWindow:=msoFalse` を指定し、さらにバックグラウンドで独立した `New PowerPoint.Application` を生成することで、目に見えない超高速バッチ処理を実現している。
② 堅牢なエラーハンドリングとクリーンアップの徹底
ネットワーク経由のファイルや、他人が作成した不完全な `.pptx` は、時に予期せぬエラー（パスワード保護、ファイル破損など）を引き起こす。
本コードでは、`On Error GoTo ErrorHandler` を用いて、万が一のファイル読み込み失敗時でも処理が途中で止まらず、CSVに `ERROR` ステータスを書き込んだ上で、確実に `pres.Close` と `pptApp.Quit` が実行されるようにライフサイクルを完全統御している。これにより、タスクマネージャーに幽霊プロセス（POWERPNT.EXE）が残留し続けるメモリリーク地獄を完全に回避している。
③ 柔軟なプロパティ取得ラッパー `GetDocProperty`
前述の通り、Officeのバージョンや言語設定、ファイルの保存履歴によっては特定の組み込みプロパティが欠落している場合がある。ラッパー関数経由でアクセスし、エラーが発生した場合はデフォルト値を返す設計にすることで、スクリプトの堅牢性を極限まで高めている。
—
4. 拡張と運用：データベースやBIツールへの連携
このマクロによって出力されたCSVファイルは、そのままの形でもExcelのピボットテーブルで分析可能だが、真価を発揮するのはBIツール（Power BIやTableau）や社内データベース（PostgreSQL / SQL Server）へのインポートである。
- 工数監査の自動化: 週に一度、Windowsの「タスク スケジューラ」からExcelやAccess経由でこのVBAをサイレント実行し、サーバー上の共有フォルダをスキャンする。
- ダッシュボード化: 「どのプロジェクトの資料作成に、どれだけの編集時間が投下されたか（Total Editing Time）」を時系列でグラフ化し、マネジメント層に自動でインサイトを提供する。
総括
業務自動化の本質は、「手作業の代替」ではなく、「手作業では絶対に得られない高品質なデータを、ノーコストで継続的にハックすること」にある。
今回紹介した `BuiltInDocumentProperties` を活用した編集工数の抽出手法は、あなたの開発組織におけるリソース管理の解像度を劇的に引き上げるキーストーンとなるはずだ。ぜひ現場のワークフローに組み込んで、その圧倒的な効率化を体感してほしい。
