【実務中級】FileSystemObject(FSO)を用いた、プロジェクトのバージョン管理バックアップシステム
レガシーな現場において、Microsoft Project（MS Project）の `.mpp` ファイルは、プロジェクトの命運を握るブラックボックスとなりがちだ。「上書き保存」のワンアクションによって、昨日のクリティカルパスが闇に葬り去られ、ステークホルダーからの「なぜスケジュールがこうなったのか」という問いに沈黙せざるを得ない悲劇を、我々は幾度となく目撃してきた。
Excelであればシートの複製やVBAによる世代管理が容易いが、Project VBAのオブジェクトモデル、そしてファイルI/Oの制御は一筋縄ではいかない。
今回は、FileSystemObject（FSO）を極限までチューニングし、Projectの保存イベント（`BeforeSave`）フックと組み合わせた、実務で即座に機能する「堅牢な世代管理バックアップシステム」の全貌を解説する。
—
1. 架构設計の要諦：なぜ標準機能や単純なFileCopyでは不十分なのか
MS Projectのファイル保存時、バックアップ要件を満たすためには以下の要件をクリアしなければならない。
1. トランザクションの整合性: 保存処理とバックアップ処理の競合を防ぐ。
2. 世代管理の自動化: `YYYYMMDD_HHMMSS` 形式のタイムスタンプ付与と、肥大化を防ぐ世代数制限（ローテーション）。
3. メモリリークの完全排除: FSOやCOMオブジェクトの適切な解放。
4. Project固有の制約への配慮: 新規未保存ファイル（パス未確定）への耐性。
単に `FileCopy` を叩くだけのコードは、ファイルが排他制御されている瞬間や、ネットワークドライブの遅延によって容易にRuntime Errorを引き起こす。実務に耐えうるアーキテクチャには、厳格なエラーハンドリングとオブジェクトライフサイクルの管理が不可欠である。
—
2. 実装コード：`ThisProject` モジュール
以下のコードを、対象となるMS Projectファイルの `ThisProject` クラスモジュールに実装する。これにより、ユーザーが「保存」を実行した瞬間に、裏側で世代管理されたバックアップが非同期的に（あるいは同期ブロックとして確実な順序で）生成される。
‘ Option Explicitの強制による暗黙の変数の排除（シニアの基本）
Option Explicit
‘ 定数定義：バックアップ世代数の上限とプレフィックス
Private Const MAX_BACKUP_GENERATIONS As Long = 10
Private Const BACKUP_FOLDER_NAME As String = “_ProjectBackups”
‘ ==============================================================================
‘ イベントプロシージャ: プロジェクト保存前処理
‘ ==============================================================================
Private Sub Project_BeforeSave(ByVal pj As Project, ByRef Cancel As Boolean)
On Error GoTo ErrorHandler
‘ 未保存の新規ファイルの場合はパスが存在しないためスキップ
If pj.FullName = “” Or pj.Path = “” Then
Exit Sub
nisSave:
End If
‘ FSOを用いたバックアップ実行
Call ExecuteVersionedBackup(pj.FullName)
Exit Sub
ErrorHandler:
‘ バックアップの失敗によって本体の保存まで阻害しない設計思想
MsgBox “バックアップの作成中に予期せぬエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & Err.Number & vbCrLf & _
“エラー内容: ” & Err.Description, vbExclamation, “バックアップ警告”
‘ 必要に応じてログ出力機構をここに結合する
End Sub
‘ ==============================================================================
‘ コアロジック: FileSystemObjectによる世代管理バックアップ
‘ ==============================================================================
Private Sub ExecuteVersionedBackup(ByVal targetFilePath As String)
Dim fso As Object
Dim targetFile As Object
Dim backupDir As String
Dim baseName As String
Dim ext As String
Dim timeStamp As String
Dim newBackupPath As String
‘ 1. FSOのインスタンス生成 (Late Bindingによるバージョン差異の吸収)
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FileExists(targetFilePath) Then Exit Sub
Set targetFile = fso.GetFile(targetFilePath)
baseName = fso.GetBaseName(targetFilePath)
ext = fso.GetExtensionName(targetFilePath)
‘ 2. バックアップ格納ディレクトリのパス構築
backupDir = targetFile.ParentFolder.Path & “\” & BACKUP_FOLDER_NAME
‘ ディレクトリが存在しない場合は自動生成
If Not fso.FolderExists(backupDir) Then
fso.CreateFolder (backupDir)
End If
‘ 3. タイムスタンプ生成 (sortable format: YYYYMMDD_HHMMSS)
timeStamp = Format(Now, “YYYYMMDD_HHMMSS”)
newBackupPath = backupDir & “\” & baseName & “_” & timeStamp & “.” & ext
‘ 4. ファイルの複製 (OverWrite = True)
fso.CopyFile targetFilePath, newBackupPath, True
‘ 5. 世代管理ローテーションの実行（古いファイルのパージ）
Call PurgeOldBackups(fso, backupDir, baseName, ext)
CleanUp:
‘ 6. メモリ最適化：オブジェクトの明示的解放
Set targetFile = Nothing
Set fso = Nothing
Exit Sub
CleanUpError:
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 世代管理ローテーション：上限を超える古いバックアップの削除
‘ ==============================================================================
Private Sub PurgeOldBackups(ByVal fso As Object, ByVal backupDir As String, ByVal baseName As String, ByVal ext As String)
Dim folderObj As Object
Dim fileObj As Object
Collection colFiles As New Collection
Dim fItem As Variant
Dim sortedFiles() As String
Dim i As Long, j As Long
Dim tempVal As String
Set folderObj = fso.GetFolder(backupDir)
‘ 対象ファイル群を収集 (命名規則に合致するもののみ)
For Each fileObj In folderObj.Files
If LCase(fso.GetExtensionName(fileObj.Path)) = LCase(ext) Then
If InStr(1, fileObj.Name, baseName & “_”) = 1 Then
colFiles.Add fileObj.Path
End If
End If
Next fileObj
‘ 上限数以下であればパージの必要なし
If colFiles.Count <= MAX_BACKUP_GENERATIONS Then
GoTo FreeObjs
End If
' 配列に詰め替えてソート（古い順）
ReDim sortedFiles(1 To colFiles.Count)
For i = 1 To colFiles.Count
sortedFiles(i) = colFiles(i)
Next i
' 簡易バブルソート（ファイル名にタイムスタンプが含まれているため文字列ソートで昇順になる）
For i = 1 To UBound(sortedFiles) - 1
For j = i + 1 To UBound(sortedFiles)
If sortedFiles(i) > sortedFiles(j) Then
tempVal = sortedFiles(i)
sortedFiles(i) = sortedFiles(j)
sortedFiles(j) = tempVal
End If
Next j
Next i
‘ 上限を超える古いファイルを先頭から削除
Dim deleteCount As Long
deleteCount = UBound(sortedFiles) – MAX_BACKUP_GENERATIONS
For i = 1 To deleteCount
If fso.FileExists(sortedFiles(i)) Then
fso.DeleteFile sortedFiles(i), True
End If
Next i
FreeObjs:
Set folderObj = Nothing
Set fileObj = Nothing
End Sub
—
3. チーフアーキテクトが解説するコードの急所
A. エラーハンドリングの哲学的分離
`Project_BeforeSave` 内のエラーハンドリングにおいて、特筆すべきは 「バックアップの失敗が本体の保存をブロックしてはならない」 という原則だ。
ネットワーク切断や権限エラーによってFSOが例外を吐いた場合でも、ユーザーの「保存する」という重大な意思決定を妨げてはならない。そのため、エラー時はメッセージボックスで警告を発するのみに留め、`Resume` や `Exit Sub` で安全に処理を抜ける設計としている。
B. COMオブジェクトの明示的解放（メモリ最適化）
VBAのガベージコレクションは頼りにならない。特にProject VBAが稼働するプロセス空間において、`CreateObject(“Scripting.FileSystemObject”)` や `GetFolder` で生成されたCOMラッパーは、スコープを抜けても即座にメモリから解放されないケースがある。
コード中の `CleanUp` ラベルで行っている `Set fso = Nothing` および `Set targetFile = Nothing` は、大規模プロジェクトを扱う現場でメモリリークを防ぐための絶対的な儀式である。これを怠ると、長時間の常駐作業時にメモリフットプリントが肥大化し、Access Violationを引き起こす元凶となる。
C. タイムスタンプベースの世代ローテーション
`YYYYMMDD_HHMMSS` のフォーマットを採用することで、ファイル名自体のアルファベット順ソートがそのまま時間軸のソートと一致するよう設計している。
これにより、複雑なファイルのタイムスタンプ取得API（Windows APIの `GetFileTime` など）をバイパスし、純粋なFSOとVBAの文字列比較のみで高速かつ安定した世代管理（ローテーション）を実現している。
—
4. さらに先へ：システム間連携とガバナンスへの昇華
このFSOベースのバックアップシステムは、単なるローカルファイルの保護にとどまらない。生成された `_ProjectBackups` フォルダを、社内のGitリポジトリやRPAの監視対象パスに指定することで、「誰もVBAを意識することなく、全社プロジェクトの変更履歴が自動的にバージョン管理システムに統合される」という、極めて高度なガバナンス体制を構築可能だ。
レガシーなツールであるMicrosoft Projectであっても、アーキテクトの知見を注ぎ込んだコードを一行組み込むだけで、現代的なCI/CD思想の恩恵を受け取ることができる。
現場の信頼性を担保するため、ぜひあなたの環境でもこの設計を取り入れてほしい。
