Project VBAを掌握する極限の知見
【上級者】プロジェクトファイルの自動圧縮とアーカイブ保存の自動化
エンタープライズ環境において、Microsoft Project（MSP）が生成する`.mpp`ファイルの肥大化は、インフラエンジニアおよびVBAアーキテクトにとって永続的な頭痛の種である。数千行に及ぶWBS、複雑なリソース割り当て、度重なるベースラインの差分データが蓄積されたプロジェクトファイルは、見た目の情報量以上にストレージを圧迫し、ネットワーク共有上に無秩序に散乱する。
本稿では、Project VBAのイベントフックを起点とし、Windows Shellオブジェクトを活用したオンザフライでのZIP圧縮、メモリ管理の極限最適化、そして世代管理を統合した「プロジェクトファイルの自動圧縮・アーカイブ保存エンジン」の全貌を解説する。
退屈なリファレンスの引き写しではない。現場の泥臭い要件と、COMオブジェクトのライフサイクルを知り尽くした者だけが到達できる、極限の自動化コードをここに提示する。
—
1. アーキテクチャ設計思想
今回構築する自動化メカニズムは、単にファイルをZIPにするだけの稚拙なスクリプトではない。以下の要件を完全満たす堅牢なアーキテクチャを持つ。
1. イベント駆動型の確実なフック: ユーザーの「名前を付けて保存」や定期バッチ保存の完了をトリガーとする。
2. 非同期的なIO処理と排他制御: 大容量MSPファイルの保存直後に発生するファイルロック（Sharing Violation）を回避するリトライ機構。
3. Shell.Applicationによるネイティブ圧縮: サードパーティ製のDLLやコマンドラインツールに依存せず、Windows標準機能のみで安全にZIPアーカイブを生成。
4. 確実なCOM解放: VBA特有の参照リークを防ぎ、ExcelやProjectのプロセスを肥大化させないメモリ管理。
—
2. 実装コード：極限まで最適化されたアーカイブエンジン
以下のコードは、ProjectのThisProjectモジュール、または標準モジュールに配置して運用することを想定したプロダクションコードである。エラーハンドリング、ファイルロック対策、そしてオブジェクトの明示的破棄を徹底している。
Option Explicit
‘ Windows API: ファイルシステムの安定性を担保するための遅延処理用
If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Else
Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
End If
‘ ==============================================================================
‘ 処理名 : AutoArchiveProject
‘ 概要 : アクティブなプロジェクトファイルを保存し、指定フォルダへZIP圧縮アーカイブ化する
‘ ==============================================================================
Public Sub AutoArchiveProject()
Dim wsShell As Object
Dim targetPath As String
Dim archiveDir As String
Dim zipFileName As String
Dim fso As Object
‘ エラーハンドリングの有効化
On Error GoTo ErrorHandler
‘ 1. オブジェクトの初期化
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 2. パスの取得とバリデーション
If ActiveProject.FullName = “” Then
MsgBox “プロジェクトがまだ保存されていません。一度手動で保存してください。”, vbCritical, “アーカイバエラー”
GoTo CleanUp
End If
targetPath = ActiveProject.FullName
archiveDir = fso.GetParentFolderName(targetPath) & “\Archive\”
‘ アーカイブ用ディレクトリが存在しない場合は作成
If Not fso.FolderExists(archiveDir) Then
fso.CreateFolder (archiveDir)
End If
‘ 3. タイムスタンプ付きZIPファイル名の生成 (例: ProjectA_202X1024_153000.zip)
Dim baseName As String
baseName = fso.GetBaseName(targetPath)
zipFileName = archiveDir & baseName & “_” & Format(Now, “yyyymmdd_hhnnss”) & “.zip”
‘ 4. 空のZIPコンテナ（ヘッダーのみ）の生成
‘ ※WindowsのShell.ApplicationでZIPを作成するには、事前に空のZIPファイルが必要
CreateEmptyZip zipFileName, fso
‘ 5. ファイル保存の完了を待つためのファイルシステムロック解除待機（リトライ機構付き）
Dim retryCount As Long
retryCount = 0
Do While IsFileLocked(targetPath)
retryCount = retryCount + 1
If retryCount > 10 Then
Err.Raise 9999, “AutoArchive”, “対象ファイルのロック解除がタイムアウトしました。”
End If
Sleep 500 ‘ 0.5秒待機
Loop
‘ 6. Shell.Application を用いたネイティブZIP圧縮
Set wsShell = CreateObject(“Shell.Application”)
‘ ZIPファイルへ対象MSPファイルをコピー（非同期処理のため待ち受けが必要）
wsShell.NameSpace(zipFileName).CopyHere targetPath
‘ 圧縮処理が完了するまでShellの動作を同期待ちする
Dim waitCounter As Long
waitCounter = 0
Do Until wsShell.NameSpace(zipFileName).Items.Count > 0
DoEvents
Sleep 200
waitCounter = waitCounter + 1
If waitCounter > 50 Then Exit Do ‘ 10秒でタイムアウト
Loop
MsgBox “プロジェクトのアーカイブ化が正常に完了しました。” & vbCrLf & _
“保存先: ” & zipFileName, vbInformation, “自動アーカイバ”
CleanUp:
‘ 7. メモリの明示的解放（極限最適化の要）
Set wsShell = Nothing
Set fso = Nothing
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“Error: ” & Err.Description, vbCritical, “致命的エラー”
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 補助関数 : 空のZIPファイルを生成する（PKZIPヘッダーの書き込み）
‘ ==============================================================================
Private Sub CreateEmptyZip(ByVal zipPath As String, ByRef fso As Object)
Dim ts As Object
‘ ZIPファイルのmagic number (Header: PK\005\006 + 18個のNull)
Dim zipHeader As String
zipHeader = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String$(18, vbNullChar)
Set ts = fso.CreateTextFile(zipPath, True)
ts.Write zipHeader
ts.Close
Set ts = Nothing
End Sub
‘ ==============================================================================
‘ 補助関数 : ファイルが排他ロックされているか判定する
‘ ==============================================================================
Private Function IsFileLocked(ByVal filePath As String) As Boolean
Dim fileNum As Long
On Error Resume Next
fileNum = FreeFile
Open filePath For Binary Access Read Write Lock Read Write As #fileNum
Close #fileNum
If Err.Number <> 0 Then
IsFileLocked = True
Else
IsFileLocked = False
End If
On Error GoTo 0
End Function
—
3. シニアエンジニアが押さえるべき技術的極意
上記のコードを実務の現場に投入するにあたり、通常のVBA解説では語られない「深層の挙動」を解説する。
① Shell.Applicationによる非同期処理の罠と対策
`wsShell.NameSpace(zipFileName).CopyHere targetPath` はバックグラウンドスレッドで実行される。そのため、VBA側がコードを即座に終了させると、ZIPへの圧縮が途中で途切れる現象（ファイル破損）が発生する。
これを防ぐため、`wsShell.NameSpace(zipFileName).Items.Count` を監視するポーリングループを挟み、ファイルシステムへの書き込み完了を強制的に同期させている。この一手間を惜しむと、本番環境で「時々壊れる謎のZIP」が生まれ、情シス部門の信頼を失墜させることになる。
② COMオブジェクトのライフサイクルとメモリ最適化
VBAにおける `CreateObject` は、背後でCOMの参照カウンタ（Reference Counter）をインクリメントする。特にプロジェクトの自動化において、ループ内やイベント内でこれを解放し忘れると、メモリリークだけでなく、Projectプロセスがバックグラウンドに残留し、次回のファイルオープン時に「ファイルが使用中です」という致命的なロックエラーを引き起こす。
本コードの `CleanUp` ラベルでは、必ずすべてのオブジェクト変数に `Nothing` を代立させ、即座にガベージコレクションの対象へと誘導している。
③ ストレージ効率の最大化
Microsoft Projectの `.mpp` フォーマットは内部構造が独自バイナリであり、XML等と比較してZIP圧縮によるサイズ削減効果が非常に高い（多くの場合、元のサイズの30%〜50程度まで縮小する）。これを日次、あるいは週次のベースライン設定時に走らせることで、ファイルサーバーの肥大化を劇的に抑制できる。
—
4. システム間連携への拡張：RPAやCI/CDパイプラインへの組み込み
このVBAアーカイブエンジンは、単体で完結させるだけでなく、企業の基幹システムやRPA（UiPathやPower Automateなど）との連携基盤としても機能する。
- Power Automate Desktop連携: 保存されたZIPファイルを検知し、自動的にMicrosoft Teamsのプロジェクトチャネルへ投稿、またはセキュアなクラウドストレージ（SharePoint）へアップロードする。
- ベースライン連動: `ProjectBeforeSave` イベントなどのアプリケーションイベントと組み合わせることで、ユーザーが意識することなく「保存の瞬間に必ず世代管理された圧縮アーカイブが生成される」完全無人化されたガバナンス体制を構築可能だ。
レガシーと評されがちなVBAであっても、OSのネイティブAPIやCOMの挙動を深く理解し、メモリ管理を極限まで突き詰めることで、現代のエンタープライズ要件に耐えうる堅牢な自動化システムへと昇華させることができる。現場のプロフェッショナルとして、ぜひこの知見を実装に活かしてほしい。
