【Project VBA】プロジェクト・ベースライン監査ログシステムの構築：外部DB連携によるガバナンスの極限統制
プロジェクトマネジメントにおいて、「ベースライン（基準計画）」はプロジェクトの成否を測るための絶対的な「憲法」です。しかし、Microsoft Project（以下、MS Project）の標準機能では、誰が、いつ、どのような理由でベースラインを保存・更新したのかという「変更履歴（監査ログ）」を厳密に追跡することができません。
現場のPMやメンバーが、進捗遅延やコスト超過を隠蔽するためにベースラインを安易に上書きしてしまう――。このようなガバナンスの崩壊を防ぐためには、ベースラインの設定・更新イベントを強制的にインターセプトし、そのメタデータと変更理由を「改ざん困難な外部データベース」へリアルタイムに書き出す仕組みが不可欠です。
本記事では、MS Project VBAを駆使し、イベントハンドリング、Windows APIによる確実なユーザー特定、そしてADO（ActiveX Data Objects）を用いた堅牢な外部DB（SQL Server / Access等）へのトランザクション書き込みを統合した、エンタープライズ基準の監査ログ出力モジュールの設計と実装を解説します。
—
1. 監査ログシステムにおける3つの設計鉄則
VBAでエンタープライズ向けの監査システムを構築する場合、Excel感覚の「動けば良い」コードは許されません。以下の3つの鉄則を厳守する必要があります。
鉄則1：環境変数の偽装を許さない（Windows APIの採用）
VBAでよく使われる `Environ(“USERNAME”)` は、プロンプトや環境変数の書き換えによって容易に偽装可能です。監査ログの信頼性を担保するため、OSのコアAPI（`Advapi32.dll`）から直接ログインユーザー名を取得します。
鉄則2：ゼロ・フリーズ設計（非同期ライクな例外処理とフォールバック）
データベースサーバーがメンテナンス中、あるいはネットワーク瞬断が発生した場合に、VBAコードがハングアップしてMS Project自体がクラッシュすることは絶対に避けなければなりません。DB接続失敗時は、即座にローカルのテキストログへエスケープ（フォールバック）し、プロジェクトの保存自体は正常に完了させる堅牢な例外処理を組み込みます。
鉄則3：イベントの完全掌握とユーザーへの理由入力強制
MS Projectの `ProjectBeforeBaselineSave` イベントをフックし、保存処理が走る直前にユーザーへ「変更理由（Reason）」の入力をダイアログで強制します。理由が未入力、あるいは文字数が足りない場合は、ベースラインの保存処理自体をキャンセル（`Cancel = True`）します。
—
2. データベース・スキーマ設計
ログを蓄積するデータベース側（SQL Server または MS Access）には、あらかじめ以下のテーブルを作成しておきます。
CREATE TABLE tbl_ProjectBaselineAudit (
LogID INT IDENTITY(1,1) PRIMARY KEY,
ProjectName NVARCHAR(255) NOT NULL,
ProjectGUID NVARCHAR(100) NOT NULL,
BaselineNum NVARCHAR(50) NOT NULL,
AppliedBy NVARCHAR(100) NOT NULL,
MachineName NVARCHAR(100) NOT NULL,
Timestamp DATETIME DEFAULT GETDATE(),
ChangeReason NVARCHAR(MAX) NOT NULL,
IsAllTasks BIT NOT NULL
);
—
3. 実装：プロダクション・グレードのVBAソースコード
このシステムは、イベントを監視するクラスモジュールと、DB接続・ログ記録を制御する標準モジュールの2層構造で構築します。
3.1. クラスモジュール：`EventClass_Project`
MS Projectのアプリケーションイベントを監視し、ベースライン保存イベントをインターセプトします。
- オブジェクト名： `EventClass_Project`
Option Explicit
‘ MS Projectのアプリケーションイベントを捕捉するグローバル変数
Public WithEvents App As MSProject.Application
”’
”’
Private Sub App_ProjectBeforeBaselineSave(ByVal pj As Project, _
ByVal Baseline As PjBaseline, _
ByVal AllTasks As Boolean, _
ByVal RollupToSummary As Boolean, _
ByVal RollupFromSubtasks As Boolean, _
Cancel As Boolean)
Dim reason As String
Dim baselineName As String
‘ ベースライン名のマッピング
baselineName = GetBaselineName(Baseline)
‘ 1. ユーザーに変更理由を強制入力させる
reason = Trim(InputBox(“【監査ログ】ベースライン (” & baselineName & “) を保存・更新する理由を入力してください（20文字以上必須）。” & vbCrLf & _
“この操作は管理者によって監査されます。”, “ベースライン変更理由の入力”))
‘ 2. 入力バリデーション（空欄や短すぎる理由は却下）
If Len(reason) < 20 Then
MsgBox "変更理由が具体的ではありません（20文字未満）。" & vbCrLf & _
"ガバナンス規程に基づき、ベースラインの保存処理をキャンセルしました。", vbCritical, "エラー: 保存却下"
Cancel = True
Exit Sub
End If
' 3. DBへログを書き出し
Dim success As Boolean
success = Mod_BaselineAuditor.WriteAuditLog(pj, baselineName, AllTasks, reason)
' 4. 結果の通知（書き込み成否に関わらず、フォールバックがあるため処理は継続）
If Not success Then
MsgBox "警告: 監査DBへの書き込みに失敗しました。ローカルログにエスケープして処理を続行します。", vbInformation, "警告"
End If
End Sub
'''
”’
Private Function GetBaselineName(ByVal Baseline As PjBaseline) As String
Select Case Baseline
Case pjBaseline: GetBaselineName = “Baseline (当初計画)”
Case pjBaseline1: GetBaselineName = “Baseline 1”
Case pjBaseline2: GetBaselineName = “Baseline 2”
Case pjBaseline3: GetBaselineName = “Baseline 3”
Case pjBaseline4: GetBaselineName = “Baseline 4”
Case pjBaseline5: GetBaselineName = “Baseline 5”
Case pjBaseline6: GetBaselineName = “Baseline 6”
Case pjBaseline7: GetBaselineName = “Baseline 7”
Case pjBaseline8: GetBaselineName = “Baseline 8”
Case pjBaseline9: GetBaselineName = “Baseline 9”
Case pjBaseline10: GetBaselineName = “Baseline 10”
Case Else: GetBaselineName = “Unknown Baseline”
End Select
End Function
—
3.2. 標準モジュール：`Mod_BaselineAuditor`
DBとの接続、Windows APIによるユーザー情報の偽装なき取得、およびエラー発生時のテキストフォールバック処理を担うコアロジックです。
- オブジェクト名： `Mod_BaselineAuditor`
Option Explicit
‘ Windows APIの宣言（64bit/32bit両対応）: 偽装不可能なユーザー名とコンピュータ名を取得
If VBA7 Then
Private Declare PtrSafe Function GetUserName Lib “advapi32.dll” Alias “GetUserNameA” (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function GetComputerName Lib “kernel32” Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long
Else
Private Declare Function GetUserName Lib “advapi32.dll” Alias “GetUserNameA” (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib “kernel32” Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long
End If
‘ イベントクラスのインスタンス保持用
Private pAppEventHandler As EventClass_Project
‘ DB接続文字列（環境に合わせてSQL ServerまたはAccess MDB/ACCDBへ変更）
‘ ※ ここではSQL Serverへの信頼接続（Windows認証）を想定
Private Const DB_CONNECTION_STRING As String = _
“Provider=MSOLEDBSQL;Server=YOUR_SQL_SERVER;Database=AuditDB;Trusted_Connection=yes;”
‘ フォールバック用ローカルログのパス
Private Const FALLBACK_LOG_PATH As String = “C:\Temp\MSProject_Audit_Fallback.log”
”’
”’
Public Sub InitializeAuditSystem()
If pAppEventHandler Is Nothing Then
Set pAppEventHandler = New EventClass_Project
Set pAppEventHandler.App = MSProject.Application
End If
End Sub
”’
”’
Public Sub TerminateAuditSystem()
Set pAppEventHandler = Nothing
End Sub
”’
”’
Public Function WriteAuditLog(ByVal pj As Project, _
ByVal baselineName As String, _
ByVal isAllTasks As Boolean, _
ByVal reason As String) As Boolean
On Error GoTo ErrorHandler
Dim conn As Object
Dim cmd As Object
Dim userName As String
Dim compName As String
‘ Windows APIより信頼性の高い情報を取得
userName = GetSystemUserName()
compName = GetSystemComputerName()
‘ ADOオブジェクトをレイトバインディングで生成（環境依存を排除）
Set conn = CreateObject(“ADODB.Connection”)
Set cmd = CreateObject(“ADODB.Command”)
‘ 接続タイムアウトを短めに設定（5秒）し、ネットワーク不通時のフリーズを防止
conn.ConnectionTimeout = 5
conn.Open DB_CONNECTION_STRING
‘ パラメータクエリによるSQLインジェクション対策を徹底
With cmd
.ActiveConnection = conn
.CommandText = “INSERT INTO tbl_ProjectBaselineAudit ” & _
“(ProjectName, ProjectGUID, BaselineNum, AppliedBy, MachineName, ChangeReason, IsAllTasks) ” & _
“VALUES (?, ?, ?, ?, ?, ?, ?);”
.CommandType = 1 ‘ adCmdText
‘ パラメータの追加（位置固定）
.Parameters.Append .CreateParameter(“@ProjName”, 202, 1, 255, pj.Name) ‘ adVarWChar = 202
.Parameters.Append .CreateParameter(“@ProjGUID”, 202, 1, 100, pj.ProjectGUID)
.Parameters.Append .CreateParameter(“@Baseline”, 202, 1, 50, baselineName)
.Parameters.Append .CreateParameter(“@User”, 202, 1, 100, userName)
.Parameters.Append .CreateParameter(“@Machine”, 202, 1, 100, compName)
.Parameters.Append .CreateParameter(“@Reason”, 203, 1, -1, reason) ‘ adLongVarWChar = 203
.Parameters.Append .CreateParameter(“@AllTasks”, 11, 1, -1, IIf(isAllTasks, -1, 0)) ‘ adBoolean = 11
‘ クエリ実行
.Execute
End With
‘ 正常終了
WriteAuditLog = True
CleanUp:
On Error Resume Next
If Not cmd Is Nothing Then Set cmd = Nothing
If Not conn Is Nothing Then
If conn.State = 1 Then conn.Close ‘ adStateOpen = 1
Set conn = Nothing
End If
Exit Function
ErrorHandler:
‘ DB書き込みに失敗した場合は、ローカルテキストファイルへエスケープ
Call LogToFallbackFile(pj.Name, pj.ProjectGUID, baselineName, userName, compName, reason, isAllTasks, Err.Description)
WriteAuditLog = False
Resume CleanUp
End Function
”’
”’
Private Sub LogToFallbackFile(ByVal projName As String, _
ByVal projGuid As String, _
ByVal baselineName As String, _
ByVal userName As String, _
ByVal compName As String, _
ByVal reason As String, _
ByVal isAllTasks As Boolean, _
ByVal dbError As String)
On Error Resume Next
Dim fileNum As Integer
Dim logLine As String
fileNum = FreeFile
Open FALLBACK_LOG_PATH For Append As #fileNum
‘ カンマや改行をエスケープした簡易CSVログの生成
logLine = Format(Now, “yyyy-MM-dd HH:mm:ss”) & “,” & _
“””” & Replace(projName, “”””, “”””””) & “””,” & _
“””” & projGuid & “””,” & _
“””” & baselineName & “””,” & _
“””” & userName & “””,” & _
“””” & compName & “””,” & _
“””” & Replace(reason, “”””, “”””””) & “””,” & _
IIf(isAllTasks, “TRUE”, “FALSE”) & “,” & _
“””” & Replace(dbError, “”””, “”””””) & “”””
Print #fileNum, logLine
Close #fileNum
End Sub
”’
”’
Private Function GetSystemUserName() As String
Dim buffer As String 255
Dim buffLen As Long
buffLen = 255
If GetUserName(buffer, buffLen) <> 0 Then
GetSystemUserName = Left$(buffer, buffLen – 1)
Else
GetSystemUserName = “UNKNOWN_USER”
End If
End Function
”’
”’
Private Function GetSystemComputerName() As String
Dim buffer As String 255
Dim buffLen As Long
buffLen = 255
If GetComputerName(buffer, buffLen) <> 0 Then
GetSystemComputerName = Left$(buffer, InStr(buffer, vbNullChar) – 1)
Else
GetSystemComputerName = “UNKNOWN_HOST”
End If
End Function
—
4. プロフェッショナルが唸る実装のポイント解説
一見シンプルなVBAコードですが、このコードにはエンタープライズ開発における「防御的プログラミング」のノウハウが凝縮されています。
① パラメータ化クエリ（プレースホルダー）の徹底
VBAからADOを使ってSQLを実行する際、多くの開発者が以下のような「文字列連結」を行ってしまいます。
‘ 【脆弱性の見本】絶対に真似してはいけないコード
sql = “INSERT INTO tbl_ProjectBaselineAudit (ChangeReason) VALUES (‘” & reason & “‘)”
これはSQLインジェクション脆弱性を引き起こすだけでなく、ユーザーが入力した理由に `’`（シングルクォーテーション）が含まれていた瞬間に構文エラーでクラッシュします。
今回提示したコードでは、`ADODB.Command` オブジェクトと `CreateParameter` を使用し、値を完全にプレースホルダー（`?`）でバインドしています。これにより、特殊文字の入力や悪意あるSQLの挿入を完全に無害化しています。
② `ProjectGUID` による厳密なファイル特定
プロジェクトのファイル名は簡単に変更できてしまいます。例えば、`プロジェクト計画_v2.mpp` が `プロジェクト計画_v3.mpp` に変更された場合、ファイル名だけをキーにしてログを追うと履歴が分断されます。
MS Projectには、ファイルごとに不変の一意なIDである `ProjectGUID` プロパティが存在します。これらをキーとしてデータベースに格納することで、ファイル名がリネームされても、同一プロジェクトの履歴として名寄せを行うことができます。
③ 徹底した「レイトバインディング」
ADO（ActiveX Data Objects）を使用する際、VBAの「参照設定（Microsoft ActiveX Data Objects x.x Library）」にチェックを入れる方法（アーリーバインディング）が一般的ですが、これをやると、配布先のPCのOfficeバージョンやOS環境の違いによって参照エラー（いわゆる「参照不可」）が発生し、ツール全体が起動しなくなるトラブルが多発します。
本コードでは `CreateObject(“ADODB.Connection”)` によるレイトバインディング（実行時バインディング）を採用しているため、配布先環境のバージョンに左右されない高いポータビリティを確保しています。
—
5. 本番運用のための導入ステップ
1. データベースの準備：
第2項で紹介した DDL を元に、組織の共有SQL Serverまたは共有フォルダ上のAccess DB（`.accdb`）に監査ログテーブルを作成します。
2. 接続文字列の書き換え：
標準モジュール `Mod_BaselineAuditor` の定数 `DB_CONNECTION_STRING` を、実際のデータベース環境に合わせて正しく設定します。
3. グローバル・テンプレート（`Global.mpt`）への組み込み：
このVBAコードを各個別の `.mpp` ファイルではなく、組織で共有するMS Projectのグローバルテンプレート（`Global.mpt`）の `ThisProject` や標準モジュールに実装します。
また、プロジェクトが開かれたタイミング（`Project_Open` イベント）で `Mod_BaselineAuditor.InitializeAuditSystem` を呼び出すように設定することで、ユーザーが意識することなく、すべてのプロジェクトファイルに対してこのガバナンス統制を強制適用することが可能になります。
6. まとめ
ベースラインの不用意な変更は、プロジェクトの遅延だけでなく、契約上のトラブルや経営層への虚偽報告に直結する重大なリスクです。
今回紹介した「MS Project VBAイベントフック ＋ 堅牢なADO連携」による監査ログシステムを導入することで、「誰が、いつ、何の目的で基準計画を変更したか」が自動的に可視化され、プロジェクトマネジメントの規律は劇的に向上します。ぜひ、あなたの組織のプロジェクト統制に役立ててください。
