本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト(未検証)です。
【VBA×WMI】外部プロセス監視と多重起動・メモリ異常を自動検知する実装手順
【背景と目的】
深夜バッチや外部連携処理の停止・多重起動を監視し、システム障害の初動対応を自動化します。
基幹連携ツールやRPA等の定期自動実行において、「バックグラウンドでプロセスがゾンビ化して残存する」「メモリリークにより後続タスクがフリーズする」といった課題が頻発します。本手法では、外部ツールの追加導入なしにVBA標準機能とWMI(Windows Management Instrumentation)を用いてプロセス情報を取得し、異常発生時にアラート通知やシート記録を行う基盤を構築します。
【処理フロー図】
以下は、WMIクエリを実行して対象プロセスを走査し、異常判定を行う一連の流れです。
graph TD
A["処理開始"] --> B["画面描画停止・初期化"]
B --> C["WMIサービス接続"]
C --> D["Win32_Processクエリ実行"]
D --> E{"プロセス存在確認"}
E -- 0件 --> F["未起動アラート設定"]
E -- 1件以上 --> G["メモリ使用量・プロセス数集計"]
G --> H{"閾値超過判定"}
H -- 正常 --> I["2次元配列に結果格納"]
H -- 異常検知 --> J["異常フラグ付与・ログ記録"]
J --> I
F --> I
I --> K["ワークシートへ一括書き込み"]
K --> L["画面描画再開・完了"]
【実装:VBAコード】
参照設定を行わずに動作する「遅延バインディング(Late Binding)」を採用しています。取得データは2次元配列へ展開し、セル書き込み回数を最小化することで高速化を図っています。
Option Explicit
' ==============================================================================
' 64bit/32bit両対応 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
' ==============================================================================
' プロセス監視および異常検知メインルーチン
' ==============================================================================
Public Sub MonitorProcesses()
Dim startTime As Double
startTime = Timer
' 高速化設定
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
On Error GoTo ErrorHandler
' 監視対象プロセスの指定(小文字で定義)
Const TARGET_PROCESS As String = "excel.exe"
Const MEMORY_LIMIT_MB As Double = 1024# ' メモリ上限閾値(MB)
Const MAX_INSTANCE_LIMIT As Long = 3 ' 最大許容多重起動数
' WMIオブジェクトの初期化(遅延バインディング)
Dim objWMIService As Object
Dim colProcesses As Object
Dim objProcess As Object
Dim query As String
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
' Win32_Processから必要項目を抽出
query = "SELECT ProcessId, Name, WorkingSetSize, CreationDate, CommandLine " & _
"FROM Win32_Process WHERE Name = '" & TARGET_PROCESS & "'"
Set colProcesses = objWMIService.ExecQuery(query)
' プロセス集計用変数
Dim processCount As Long
processCount = colProcesses.Count
' 出力用配列の確保(ヘッダー + データ行、6列)
Dim resultData() As Variant
Dim maxRows As Long
maxRows = IIf(processCount > 0, processCount, 1)
ReDim resultData(1 To maxRows + 1, 1 To 6)
' ヘッダー定義
resultData(1, 1) = "プロセスID"
resultData(1, 2) = "プロセス名"
resultData(1, 3) = "メモリ使用量(MB)"
resultData(1, 4) = "起動日時"
resultData(1, 5) = "ステータス判定"
resultData(1, 6) = "コマンドライン引数"
Dim rowIndex As Long
rowIndex = 2
Dim isAbnormal As Boolean
isAbnormal = False
' プロセス情報の走査と異常判定
If processCount = 0 Then
resultData(2, 1) = "-"
resultData(2, 2) = TARGET_PROCESS
resultData(2, 3) = 0
resultData(2, 4) = "-"
resultData(2, 5) = "【警告】プロセス未起動"
resultData(2, 6) = "-"
isAbnormal = True
Else
Dim memMB As Double
Dim createDateRaw As String
Dim formattedDate As String
For Each objProcess In colProcesses
' メモリ換算 (Byte -> MB)
memMB = Round(CDbl(objProcess.WorkingSetSize) / (1024# * 1024#), 2)
' WMI日付形式 (YYYYMMDDHHMMSS.xxxxxx+xxx) の変換
createDateRaw = CStr(objProcess.CreationDate)
If Len(createDateRaw) >= 14 Then
formattedDate = Mid(createDateRaw, 1, 4) & "/" & _
Mid(createDateRaw, 5, 2) & "/" & _
Mid(createDateRaw, 7, 2) & " " & _
Mid(createDateRaw, 9, 2) & ":" & _
Mid(createDateRaw, 11, 2) & ":" & _
Mid(createDateRaw, 13, 2)
Else
formattedDate = "不明"
End If
' 判定ロジック
Dim statusText As String
statusText = "正常"
If memMB > MEMORY_LIMIT_MB Then
statusText = "【異常】メモリ過多"
isAbnormal = True
End If
If processCount > MAX_INSTANCE_LIMIT Then
statusText = statusText & " / 【警告】多重起動超過"
isAbnormal = True
End If
' 配列へ格納
resultData(rowIndex, 1) = objProcess.ProcessId
resultData(rowIndex, 2) = objProcess.Name
resultData(rowIndex, 3) = memMB
resultData(rowIndex, 4) = formattedDate
resultData(rowIndex, 5) = statusText
resultData(rowIndex, 6) = IIf(IsNull(objProcess.CommandLine), "取得不可", objProcess.CommandLine)
rowIndex = rowIndex + 1
Next objProcess
End If
' シートへの一括出力
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
ws.Cells.ClearContents
ws.Range("A1").Resize(UBound(resultData, 1), UBound(resultData, 2)).Value = resultData
ws.Columns("A:F").AutoFit
' 異常検知時の通知(運用に応じてメール送信等に置換可能)
If isAbnormal Then
MsgBox "監視対象プロセスに異常を検知しました。" & vbCrLf & _
"詳細は出力シートを確認してください。", vbExclamation, "プロセス監視アラート"
End If
CleanUp:
' オブジェクト解放と画面描画復帰
Set objProcess = Nothing
Set colProcesses = Nothing
Set objWMIService = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrorHandler:
MsgBox "プロセス監視中にエラーが発生しました: " & Err.Description, vbCritical, "システムエラー"
Resume CleanUp
End Sub
【技術解説】
WMI(Win32_Process)の遅延バインディング
GetObject("winmgmts:\\.\root\cimv2")を利用することで、端末ごとの参照設定の不整合を防ぎ、配布時のトラブルを回避しています。クエリ(WQL)による抽出の軽量化
SELECT *ではなく必要なプロパティ(ProcessId,WorkingSetSize,CreationDateなど)に絞り、WHERE Name = ...で抽出することで、WMIプロバイダの負荷と取得時間を大幅に短縮しています。2次元配列による一括転記
ループ内でのセルアクセス(Cells(i, j).Value = ...)を排除し、メモリ上に確保した配列へ展開後、Range.Resizeで一括出力することで描画コストを抑制しています。
【注意点と運用】
管理者権限とセキュリティポリシーの制限
CommandLineなどの一部プロパティは、実行ユーザーの権限不足(一般ユーザー権限)によってNullを返す場合があります。IsNullによるガード節が必須です。64bit環境におけるWin32 APIのポインタ型宣言
待機処理等でWin32 APIを用いる場合は、LongPtr/PtrSafeを明示し、Officeの32bit/64bit双方でコンパイルエラーが発生しない設計を維持してください。WMIサービスの破損リスク
極稀にクライアントPCのWMIリポジトリが破損している場合、GetObjectで実行時エラーが発生します。エラーハンドラ(On Error GoTo ErrorHandler)による安全な終了処理を必ず組み込んでください。
【まとめ】
監視の自動化:WMIを活用することで、OS標準機能のみでプロセス数・メモリ異常・起動状態を即座に判定可能。
配列による高速化:取得情報を2次元配列にバッファリングし、セル操作のオーバーヘッドを極小化する。
堅牢なエラーハンドリング:権限不足によるプロパティ取得エラーやWMI障害を想定した安全設計を徹底する。

コメント