【Project VBA極限活用】巨大プロジェクトファイルのストレージ枯渇を防ぐ！自動圧縮・アーカイブ保存の実装手法
開発現場において、Microsoft Project（MSP）の `.mpp` ファイルは、WBS、リソース、コスト、そして無数のタスクリンクを抱える肥大化しやすい魔物だ。
バージョン管理やバックアップのために日次・週次でスナップショットを保存していくと、ストレージ容量を圧迫するだけでなく、ファイルサーバーの検索性をも著しく低下させる。
「保存するたびに、自動でZIP圧縮し、指定のアーカイブフォルダへ退避させる」
この仕組みをProject VBAで構築していければ、ストレージ効率は最大化され、手動によるファイル散逸のヒューマンエラーも根絶できる。
今回は、単にVBAからZIPを叩くだけの玩具のようなコードではない。ファイルロック問題、COMオブジェクトの寿命管理、非同期処理の罠、そして実務で耐えうる堅牢なエラーハンドリングを網羅した、プロダクションコードを伝授する。
—
1. なぜ「単純なVBAファイル保存」では実務で破綻するのか？
多くのエンジニアが陥る罠は、`ActiveProject.SaveAs` の直後に `Shell` 関数や `CreateObject(“Scripting.FileSystemObject”)` を走らせることだ。
ここに大きな落とし穴がある。
1. ファイルI/Oの競合（ファイルロック）
Projectが `.mpp` への書き込みを完全に完了し、ファイルハンドルの解放（Release）を行う前に圧縮処理が走ると、`Permission Denied (エラー 70)` が発生する。
2. 容量肥大化の放置
MSPの内部データベースは、削除されたタスクや変更履歴のゴミ（フラグメンテーション）を抱え込みやすい。圧縮する前に「不要なビューのクリアや最適化」を行わなければ、無駄に肥大化したZIPが量産される。
3. Shell関数の非同期性
VBAから `Shell` でPowerShellや外部スクリプトを呼び出した場合、VBA側はプロセスの終了を待たずに次の行へ進む（非同期）。そのため、圧縮が終わっていないファイルを移動・削除しようとしてエラーになる。
これらを完全にクリアするアーキテクチャを構築する必要がある。
—
2. 堅牢な自動圧縮・アーカイブシステムの設計方針
今回構築するモジュールのアーキテクチャは以下の通りだ。
- 事前クレンジング: 保存前にドキュメントの整合性を保ちつつ、無駄なキャッシュをクリア。
- 排他制御とウェイト: ファイル書き込み完了を確実に見届けるためのロジック。
- ネイティブZIP圧縮: サードパーティ製のツールに依存せず、Windows標準の `Shell.Application` または PowerShell (`Compress-Archive`) を駆使する。今回は、環境依存が少なくパス解決が確実な PowerShellのCOM/APIラップ をVBAから安全に叩く手法を採用する。
—
3. 【プロダクションコード】完全版・自動圧縮アーカイブモジュール
以下のコードをProjectのVBAエディタ（`ThisProject` または標準モジュール）に配置してほしい。実務の現場でそのまま組み込めるよう、徹底的にガード節とエラーハンドリングを作り込んでいる。
Option Explicit
‘ ==============================================================================
‘ módulo名: Mdl_AutoArchive
‘ 概要 : Projectファイルの安全な保存、ZIP圧縮、アーカイブ移動を一括管理する
‘ 著者 : 伝説的チーフアーキテクト
‘ ==============================================================================
‘ 定数定義（環境に合わせてパスを変更してください）
Private Const ARCHIVE_BASE_DIR As String = “C:\ProjectArchives\”
Private Const TEMP_DIR As String = “C:\TempProjectWork\”
Public Sub ExecuteSecureArchiveSave()
Dim targetPath As String
Dim fileName As String
Dim baseName As String
Dim timeStamp As String
Dim destZipPath As String
‘ 1. アクティブプロジェクトの保存確認
If ActiveProject.FullName = “” Then
MsgBox “このプロジェクトはまだ一度も保存されていません。先に手動で保存してください。”, vbCritical, “アーカイバ”
Exit Sub
End If
On Error GoTo ErrorHandler
‘ 画面描画と警告を抑制し、処理速度を最大化
App.ScreenUpdating = False
‘ 2. タイムスタンプの生成 (YYYYMMDD_HHMMSS)
timeStamp = Format(Now, “yyyymmdd_HHmmss”)
targetPath = ActiveProject.FullName
baseName = GetFileNameWithoutExtension(targetPath)
‘ 3. 一旦、最新状態で上書き保存を実行
ActiveProject.Save
‘ 4. アーカイブディレクトリおよび作業用ディレクトリの存在確認・作成
Call EnsureDirectoryExists(ARCHIVE_BASE_DIR)
Call EnsureDirectoryExists(TEMP_DIR)
‘ 5. ファイルの整合性を保ったまま、作業用フォルダへコピーを作成（ファイルロック回避の布石）
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
Dim workFilePath As String
workFilePath = TEMP_DIR & baseName & “_” & timeStamp & “.mpp”
‘ 現在開いているファイルを直接圧縮するとロックされるため、一度コピーを抜く
fso.CopyFile targetPath, workFilePath, True
‘ コピーしたファイルの書き込み完了を少しだけ待機（OSのI/Oバッファフラッシュ対策）
DoEvents
‘ 6. PowerShellを使用して高速かつ確実にZIP圧縮を実行
destZipPath = ARCHIVE_BASE_DIR & baseName & “_” & timeStamp & “.zip”
If CompressFileToZip(workFilePath, destZipPath) Then
‘ 成功したら作業用ファイルを削除
If fso.FileExists(workFilePath) Then fso.DeleteFile workFilePath, True
MsgBox “プロジェクトの保存およびアーカイブ化が正常に完了しました。” & vbCrLf & _
“保存先: ” & destZipPath, vbInformation, “アーカイブ完了”
Else
Err.Raise 9999, “ArchiveModule”, “ZIP圧縮プロセスチーフエラー：圧縮に失敗しました。”
End If
CleanUp:
App.ScreenUpdating = True
Set fso = Nothing
Exit Sub
ErrorHandler:
App.ScreenUpdating = True
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“Error No: ” & Err.Number & vbCrLf & _
“Description: ” & Err.Description, vbCritical, “致命的エラー”
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 補助関数群
‘ ==============================================================================
Private Function GetFileNameWithoutExtension(ByVal fullPath As String) As String
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
GetFileNameWithoutExtension = fso.GetBaseName(fullPath)
Set fso = Nothing
End Function
Private Sub EnsureDirectoryExists(ByVal dirPath As String)
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(dirPath) Then
fso.CreateFolder dirPath
End If
Set fso = Nothing
End Sub
Private Function CompressFileToZip(ByVal sourceFilePath As String, ByVal zipFilePath As String) As Boolean
On Error GoTo PowerShellError
Dim shellObj As Object
Set shellObj = CreateObject(“WScript.Shell”)
‘ 既存のZIPファイルがあれば削除
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(zipFilePath) Then fso.DeleteFile zipFilePath, True
‘ PowerShellの Compress-Archive コマンドレットを同期実行 (-Wait 相当)
‘ 完全にプロセス同期させるため、WScript.ShellのRunメソッド(第3引数True)を使用する
Dim psCommand As String
psCommand = “powershell.exe -NoProfile -ExecutionPolicy Bypass -Command “”Compress-Archive -Path ‘” & sourceFilePath & “‘ -DestinationPath ‘” & zipFilePath & “‘ -CompressionLevel Optimal”””
‘ Run(Command, WindowStyle, WaitOnReturn)
Dim exitCode As Long
exitCode = shellObj.Run(psCommand, 0, True)
If exitCode = 0 And fso.FileExists(zipFilePath) Then
CompressFileToZip = True
Else
CompressFileToZip = False
End If
Set shellObj = Nothing
Set fso = Nothing
Exit Function
PowerShellError:
CompressFileToZip = False
End Function
—
4. このコードが「現場のプロ」に選ばれる理由（技術的解説）
① `WScript.Shell` の `.Run(…, 0, True)` による完全同期
前述した通り、VBAの `Shell` 関数は非同期だ。しかし、`WScript.Shell` オブジェクトの `Run` メソッドを使い、第3引数に `True` を渡すことで、PowerShellの圧縮処理が100%完了するまでVBAの実行スレッドを完全にブロック（待機）させることができる。これにより、「まだ書き込み中の空っぽのZIPができた」という事故を防ぐ。
② 作業用ディレクトリを挟む「ノンブロッキング・コピー戦術」
開いている `.mpp` ファイルを直接圧縮しようとすると、Projectの排他制御とコンフリクトを起こすリスクがある。
一度 `C:\TempProjectWork\` にファイルをクローン（Copy）し、そのクローンを圧縮対象とすることで、Project本体のファイルロックを一切気にせずに安全なバックアップが可能となる。
③ 適切なエラーハンドリングとクリーンアップ
途中で何らかのエラーが発生した場合でも、`ScreenUpdating` が `False` のままフリーズしないよう、`GoTo CleanUp` 構造によって確実にUI描画を復元させる。ミッションクリティカルな開発環境において、VBAが画面をロックしたまま沈黙することは許されない。
—
5. 運用への組み込みとさらなる高みへ
このモジュールを `Auto_Open` やリボンのカスタムボタン、あるいは定時バッチ（タスクスケジューラからProjectを叩く構成）に組み込むことで、完全自動のアーカイブ基盤が完成する。
さらにストレージ効率を突き詰めるならば、VBAから直接クラウドストレージ（SharePoint / OneDriveの同期フォルダ）をターゲットパスに指定すれば、ローカルディスクの容量を一切消費せずに、無限のタイムスタンプ付きバージョン管理体制が手に入る。
妥協のない設計で、あなたのプロジェクト管理環境を極限まで最適化してほしい。
