VBAでWindowsイベントログを監視

Tech

本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。

VBAでWindowsイベントログを監視

背景と要件

Windowsシステムでは、アプリケーションの動作、セキュリティイベント、システムエラーなど、多岐にわたる情報がイベントログに記録されます。これらのログを監視することで、システムの異常を早期に検知したり、特定のアプリケーションの挙動を追跡したりすることが可能になります。 、Microsoft Office製品（Excel、Accessなど）のVBA（Visual Basic for Applications）を用いて、Windowsイベントログを監視する具体的な方法を解説します。外部ライブラリの使用を禁止し、Windowsが提供するWin32 APIを直接呼び出すことで、Office環境のみで完結するソリューションを構築することを目標とします。特に「監視」については、VBAの特性上、真のリアルタイム通知は困難なため、ポーリング（定期的な状態確認）による疑似的な監視手法を実装します。

設計

監視方式の検討

VBAでWindowsイベントログを監視する際、大きく分けて以下の2つのアプローチが考えられます。

  1. 一括読み込み: 特定のログファイル（例: Application、System、Security）から、過去のイベントをまとめて読み込む方法。一度に大量のデータを取得するのに適しています。

  2. ポーリング監視: 定期的にイベントログをチェックし、前回確認時以降に発生した新しいイベントのみを検出する方法。「監視」という要件に対して、VBAで最も実現しやすいアプローチです。NotifyChangeEventLog APIも存在しますが、VBAで非同期コールバックやウィンドウメッセージを効果的に処理するのは非常に困難であり、外部コンポーネントなしでは実質的に不可能です。そのため、本記事ではポーリングを採用します。

Win32 APIの選定

イベントログへのアクセスには、kernel32.dll に含まれる以下のWin32 APIを使用します。

  • OpenEventLog：監視対象のイベントログファイル（例: “Application”）を開き、ハンドルを取得します。

  • ReadEventLog：イベントログからデータを読み込みます。イベントレコードは EVENTLOGRECORD 構造体として取得されます。

  • CloseEventLog：開いたイベントログのハンドルを閉じます。

  • GetLastError：直前のAPI呼び出しで発生したエラーコードを取得します。

  • CopyMemory：メモリブロックをコピーするために使用します。EVENTLOGRECORD構造体の可変長部分をVBAで解析する際に利用します。

データモデル

読み込んだイベントログの情報をVBA内で扱うために、以下の情報を格納するカスタム型を定義し、それを配列やワークシートに展開します。

  • レコード番号（RecordNumber）

  • 生成日時（TimeGenerated）

  • イベントID（EventID）

  • イベントの種類（EventType）

  • ソース名（SourceName）

  • コンピューター名（ComputerName）

  • （オプション）イベントメッセージの簡単な要約

処理フロー（ポーリング監視）

ポーリングによるイベント監視の処理フローは以下のようになります。

graph TD
    A["開始"] --> B{"監視設定の初期化"};
    B --> C["前回の最終レコード番号の取得"];
    C --> D{"イベントログをオープン"};
    D -- 成功 --> E["無限ループ (または定期的実行)"];
    E --> F{"新しいイベントログの読み込み"};
    F -- 新しいイベントあり --> G["各イベントの解析と処理"];
    G --> H["最終レコード番号の更新"];
    H --> I{"一定時間待機"};
    I --> E;
    F -- 新しいイベントなし --> I;
    D -- 失敗 --> J["エラー処理"];
    J --> K["終了"];
    E -- 監視停止指示 --> K;

  • A[開始]: VBAプロシージャの実行開始。

  • B{監視設定の初期化}: 監視対象ログ名（例: “Application”）、ポーリング間隔などの初期設定を行います。

  • C[前回の最終レコード番号の取得]: 監視の継続性を保つため、前回処理したイベントのレコード番号を記憶しておきます（例: ワークシートや変数）。初回実行時は0とします。

  • D{イベントログをオープン}: OpenEventLog APIを呼び出し、指定されたログ（例: “Application”）のハンドルを取得します。

  • E[無限ループ (または定期的実行)]: ポーリング処理の本体。Application.OnTime を使って定期的に呼び出すか、DoEvents を挟んだループで実行します。

  • F{新しいイベントログの読み込み}: ReadEventLog APIを呼び出し、前回の最終レコード番号以降のイベントを読み込みます。読み込み方向は EVENTLOG_FORWARDS_READ を指定します。

  • G[各イベントの解析と処理]: 読み込んだ EVENTLOGRECORD 構造体から必要な情報を抽出し、VBAのオブジェクトやワークシートに書き込むなどの処理を行います。

  • H[最終レコード番号の更新]: 今回処理した中で最も新しいイベントのレコード番号を記録します。

  • I{一定時間待機}: Sleep APIなどを用いて、指定されたポーリング間隔だけ処理を停止します。

  • J[エラー処理]: OpenEventLog や ReadEventLog の失敗時、GetLastError でエラー情報を取得し、適切な処理を行います。

  • K[終了]: 監視が停止された場合にログハンドルを閉じ、プロシージャを終了します。

実装

Win32 API宣言と構造体

まず、VBAモジュールにWin32 APIの宣言と EVENTLOGRECORD 構造体を定義します。EVENTLOGRECORD は可変長部分を含むため、固定長部分のみをVBAの Type で定義し、可変長データはバイト配列として読み込み、CopyMemory で抽出します。

' 標準モジュールに記述
Option Explicit

' Win32 API 宣言
#If VBA7 Then

    Private Declare PtrSafe Function OpenEventLog Lib "kernel32" Alias "OpenEventLogA" ( _
        ByVal lpUNCServerName As String, _
        ByVal lpSourceName As String _
    ) As LongPtr

    Private Declare PtrSafe Function ReadEventLog Lib "kernel32" ( _
        ByVal hEventLog As LongPtr, _
        ByVal dwReadFlags As Long, _
        ByVal dwRecordOffset As Long, _
        ByVal lpBuffer As Any, _
        ByVal nNumberOfBytesToRead As Long, _
        ByRef pnBytesRead As Long, _
        ByRef pnMinNumberOfBytesNeeded As Long _
    ) As Long

    Private Declare PtrSafe Function CloseEventLog Lib "kernel32" ( _
        ByVal hEventLog As LongPtr _
    ) As Long

    Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long

    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        Destination As Any, _
        Source As Any, _
        ByVal Length As Long _
    )
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else

    Private Declare Function OpenEventLog Lib "kernel32" Alias "OpenEventLogA" ( _
        ByVal lpUNCServerName As String, _
        ByVal lpSourceName As String _
    ) As Long

    Private Declare Function ReadEventLog Lib "kernel32" ( _
        ByVal hEventLog As Long, _
        ByVal dwReadFlags As Long, _
        ByVal dwRecordOffset As Long, _
        ByVal lpBuffer As Any, _
        ByVal nNumberOfBytesToRead As Long, _
        ByRef pnBytesRead As Long, _
        ByRef pnMinNumberOfBytesNeeded As Long _
    ) As Long

    Private Declare Function CloseEventLog Lib "kernel32" ( _
        ByVal hEventLog As Long _
    ) As Long

    Private Declare Function GetLastError Lib "kernel32" () As Long

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        Destination As Any, _
        Source As Any, _
        ByVal Length As Long _
    )
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

' イベントログ読み込みフラグ
Private Const EVENTLOG_FORWARDS_READ As Long = &H4       ' 順方向に読み込み
Private Const EVENTLOG_SEQUENTIAL_READ As Long = &H8    ' シーケンシャル読み込み

' EVENTLOGRECORD 構造体 (固定長部分のみ)
' この構造体の後に可変長データ (SourceName, ComputerName, StringInserts, Data) が続く
Private Type EVENTLOGRECORD_FIXED
    Length As Long          ' このレコード全体の長さ (バイト単位)
    Reserved As Long        ' 予約済み
    RecordNumber As Long    ' レコード番号
    TimeGenerated As Long   ' イベントが生成されたUTCタイムスタンプ
    TimeWritten As Long     ' イベントがログに書き込まれたUTCタイムスタンプ
    EventID As Long         ' イベント識別子
    EventType As Integer    ' イベントタイプ
    NumStrings As Integer   ' レコードに含まれる文字列の数
    EventCategory As Integer ' イベントカテゴリ
    ReservedFlags As Integer ' 予約済み
    ClosingRecordNumber As Long ' 予約済み
    SourceNameOffset As Long ' ソース名文字列へのオフセット
    ComputerNameOffset As Long ' コンピュータ名文字列へのオフセット
    DataOffset As Long      ' イベント固有のデータへのオフセット
    DataLength As Long      ' イベント固有のデータの長さ
End Type

' 抽出したイベント情報を格納するカスタム型
Public Type EventLogEntry
    RecordNumber As Long
    TimeGenerated As Date
    EventID As Long
    EventType As String
    SourceName As String
    ComputerName As String
End Type

' グローバル変数 (ポーリング監視用)
#If VBA7 Then

    Private hEventLogGlobal As LongPtr
#Else

    Private hEventLogGlobal As Long
#End If

Private fMonitoringActive As Boolean
Private lLastRecordNumber As Long ' 最後に処理したレコード番号

コード例1: 最新のイベントをまとめて読み込む

指定されたログから最新のイベントを一定数読み込み、Excelワークシートに一覧表示します。

'---------------------------------------------------------------------------------------------------
' 関数名: ReadRecentEventLogs
' 概要: 指定されたWindowsイベントログから最新のイベントを指定数読み込み、ワークシートに出力します。
' 前提: Excelワークブックが開いており、アクティブシートが存在すること。
'       Win32 APIのDeclare文が標準モジュールに正しく記述されていること。
' 引数:
'   logName (String): 読み込むイベントログの名前 (例: "Application", "System", "Security")
'   maxRecords (Long): 読み込む最大イベント数
' 戻り値:
'   Boolean: 成功した場合は True、失敗した場合は False
' 備考:
'   - EVENTLOGRECORDの可変長部分 (特にStringInserts) の解析は複雑なため、
'     ここではSourceNameとComputerNameの抽出に限定しています。
'     完全なメッセージ解析にはFormatMessage APIやイベントソースのDLL情報が必要です。
'   - 性能チューニングとして、ScreenUpdatingを無効にし、データを配列に格納してから一括書き込みます。
' --------------------------------------------------------------------------------------------------
Public Function ReadRecentEventLogs(ByVal logName As String, ByVal maxRecords As Long) As Boolean
    Dim hLog As LongPtr ' イベントログハンドル
    Dim byteBuffer() As Byte ' イベントログデータを読み込むバッファ
    Dim nBytesRead As Long ' 実際に読み込まれたバイト数
    Dim nMinBytesNeeded As Long ' 読み込みに必要な最小バイト数
    Dim lRet As Long ' ReadEventLogの戻り値
    Dim lErr As Long ' GetLastErrorの戻り値

    Dim records() As EventLogEntry ' 抽出したイベントを格納する配列
    Dim recordCount As Long ' 読み込んだイベントの数
    Dim i As Long ' ループカウンタ

    Dim ws As Worksheet ' 出力先のワークシート
    Dim rowNum As Long ' ワークシートの行番号

    ' 性能チューニング開始
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual ' 計算モードを手動に設定 (Excelの場合)

    On Error GoTo ErrorHandler

    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = logName & "ログ_" & Format(Now(), "yyyymmdd_hhmmss")
    ws.Cells(1, 1).Value = "レコード番号"
    ws.Cells(1, 2).Value = "日時"
    ws.Cells(1, 3).Value = "イベントID"
    ws.Cells(1, 4).Value = "タイプ"
    ws.Cells(1, 5).Value = "ソース"
    ws.Cells(1, 6).Value = "コンピューター"
    ws.Rows(1).Font.Bold = True

    ' イベントログを開く
    hLog = OpenEventLog(vbNullString, logName)
    If hLog = 0 Then
        lErr = GetLastError()
        MsgBox "イベントログ '" & logName & "' のオープンに失敗しました。エラーコード: " & lErr, vbCritical
        ReadRecentEventLogs = False
        GoTo Exit_Function
    End If

    ' バッファの初期サイズ (最大100レコード程度を想定)
    ReDim byteBuffer(0 To 65535 - 1) ' 64KB

    ' イベントログを逆順で読み込み、最新のイベントを取得
    ' dwRecordOffset は EVENTLOG_SEQUENTIAL_READ と組み合わせる場合は無視される
    ' dwReadFlags = EVENTLOG_BACKWARDS_READ Or EVENTLOG_SEQUENTIAL_READ を使って逆順で最新から読み込む
    ' ただし、ここではシンプルに順方向で最初から読み込み、最新N件を保持する
    ' ReadEventLogは実際には、dwRecordOffsetが0の場合、ログの先頭から読み込むため、
    ' 最新N件を取得するには全てのログを読み込むか、適切なフィルタリングが必要となる。
    ' ここでは「最新」を「最後に読み込んだN件」と解釈する。

    Dim currentBufferPos As Long
    Dim currentRecord As EVENTLOGRECORD_FIXED
    Dim recordOffset As Long
    Dim sName As String, cName As String

    recordCount = 0
    ReDim records(1 To maxRecords) ' 取得する最大レコード数分の配列を確保

    Do
        lRet = ReadEventLog(hLog, EVENTLOG_FORWARDS_READ Or EVENTLOG_SEQUENTIAL_READ, 0, _
                            byteBuffer(0), UBound(byteBuffer) + 1, nBytesRead, nMinBytesNeeded)

        If lRet = 0 Then
            lErr = GetLastError()
            If lErr = 234 Then ' ERROR_INSUFFICIENT_BUFFER (より大きなバッファが必要)
                ' バッファを再割り当てしてリトライ (ここでは簡略化のためスキップ、必要に応じて実装)
                ' Debug.Print "バッファが不足しました。必要なバイト数: " & nMinBytesNeeded
                ' ReDim byteBuffer(0 To nMinBytesNeeded - 1)
                ' Continue Do
            ElseIf lErr = 0 Then ' ログの終端に到達 (読み込むイベントがもうない)
                Exit Do
            Else
                MsgBox "イベントログの読み込みに失敗しました。エラーコード: " & lErr, vbCritical
                GoTo Exit_Function
            End If
        End If

        currentBufferPos = 0
        Do While currentBufferPos < nBytesRead
            ' 固定長部分をコピー
            CopyMemory currentRecord, byteBuffer(currentBufferPos), Len(currentRecord)

            ' レコードの総バイト数が取得済みバイト数を超えないことを確認
            If currentBufferPos + currentRecord.Length > nBytesRead Then Exit Do

            ' イベント情報を抽出
            If recordCount < maxRecords Then
                recordCount = recordCount + 1
            Else
                ' maxRecordsを超えたら、最も古いレコードを破棄し、新しいレコードを末尾に追加
                For i = 1 To maxRecords - 1
                    records(i) = records(i + 1)
                Next i
            End If

            ' 現在のレコードを配列に格納
            With records(recordCount)
                .RecordNumber = currentRecord.RecordNumber
                .TimeGenerated = DateAdd("s", currentRecord.TimeGenerated, #1/1/1970#) ' UTC Unix TimeからDateに変換
                .EventID = currentRecord.EventID And &HFFFF& ' 下位16ビットのみ (実際のEventIDはより複雑な場合あり)
                .EventType = GetEventTypeString(currentRecord.EventType)

                ' SourceNameとComputerNameの抽出
                ' オフセットはEVENTLOGRECORDの先頭からの相対オフセット
                ' CopyMemoryはアドレスを受け取るので、byteBufferの要素アドレスを渡す
                If currentRecord.SourceNameOffset > 0 Then
                    sName = ExtractStringFromBuffer(byteBuffer, currentBufferPos + currentRecord.SourceNameOffset)
                    .SourceName = sName
                Else
                    .SourceName = ""
                End If

                If currentRecord.ComputerNameOffset > 0 Then
                    cName = ExtractStringFromBuffer(byteBuffer, currentBufferPos + currentRecord.ComputerNameOffset)
                    .ComputerName = cName
                Else
                    .ComputerName = ""
                End If
            End With

            currentBufferPos = currentBufferPos + currentRecord.Length
        Loop
    Loop While nBytesRead > 0 And currentBufferPos = nBytesRead ' バッファが完全に消費されたら再度読み込み

    ' 読み込んだイベントをワークシートに書き出す
    rowNum = 2
    For i = 1 To recordCount
        With ws
            .Cells(rowNum, 1).Value = records(i).RecordNumber
            .Cells(rowNum, 2).Value = records(i).TimeGenerated
            .Cells(rowNum, 3).Value = records(i).EventID
            .Cells(rowNum, 4).Value = records(i).EventType
            .Cells(rowNum, 5).Value = records(i).SourceName
            .Cells(rowNum, 6).Value = records(i).ComputerName
            rowNum = rowNum + 1
        End With
    Next i

    ws.Columns("A:F").AutoFit ' 列幅を自動調整

    ReadRecentEventLogs = True

Exit_Function:
    If hLog <> 0 Then Call CloseEventLog(hLog) ' ログハンドルを閉じる

    ' 性能チューニング終了
    Application.Calculation = xlCalculationAutomatic ' 計算モードを自動に戻す
    Application.ScreenUpdating = True
    Exit Function

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    ReadRecentEventLogs = False
    Resume Exit_Function
End Function

' イベントタイプを文字列に変換するヘルパー関数
Private Function GetEventTypeString(ByVal eventType As Integer) As String
    Select Case eventType
        Case 1: GetEventTypeString = "Error"
        Case 2: GetEventTypeString = "Warning"
        Case 4: GetEventTypeString = "Information"
        Case 8: GetEventTypeString = "Success Audit"
        Case 16: GetEventTypeString = "Failure Audit"
        Case Else: GetEventTypeString = "Unknown (" & eventType & ")"
    End Select
End Function

' バイト配列からNull終端文字列を抽出するヘルパー関数
Private Function ExtractStringFromBuffer(buffer() As Byte, ByVal offset As Long) As String
    Dim i As Long
    Dim sTemp As String
    Dim startAddr As LongPtr

    sTemp = ""
    i = offset
    ' バッファの範囲チェック
    If offset < 0 Or offset >= UBound(buffer) Then Exit Function

    ' null終端までをコピー
    Do While i <= UBound(buffer) And buffer(i) <> 0
        sTemp = sTemp & Chr(buffer(i))
        i = i + 1
    Loop
    ExtractStringFromBuffer = sTemp
End Function

' 使用例
Sub Sample_ReadRecentEventLogs()
    If ReadRecentEventLogs("Application", 500) Then
        MsgBox "最新500件のApplicationログを読み込みました。", vbInformation
    Else
        MsgBox "ログの読み込みに失敗しました。", vbCritical
    End If
End Sub

コード例2: イベントログのポーリング監視

指定されたイベントログを定期的にポーリングし、新規イベントがあれば処理する機能を提供します。Excelの Application.OnTime を利用して、バックグラウンドでの定期実行を模倣します。

'---------------------------------------------------------------------------------------------------
' サブルーチン名: StartEventLogMonitor
' 概要: Windowsイベントログのポーリング監視を開始します。
' 前提: Win32 APIのDeclare文、EVENTLOGRECORD_FIXED構造体、EventLogEntry型が
'       標準モジュールに正しく記述されていること。
'       グローバル変数 hEventLogGlobal, fMonitoringActive, lLastRecordNumber が宣言されていること。
' 引数:
'   logName (String): 監視するイベントログの名前 (例: "Application", "System", "Security")
'   intervalSeconds (Long): ポーリング間隔 (秒単位)
' 備考:
'   - ExcelのApplication.OnTimeメソッドを利用して定期実行をスケジューリングします。
'   - Accessの場合はフォームのタイマーイベントなどを使用します。
'   - 性能チューニングとして、ScreenUpdatingを無効にします。
'---------------------------------------------------------------------------------------------------
Public Sub StartEventLogMonitor(ByVal logName As String, ByVal intervalSeconds As Long)
    Dim lErr As Long

    If fMonitoringActive Then
        MsgBox "既にイベントログ監視は実行中です。", vbInformation
        Exit Sub
    End If

    ' イベントログを開く
    hEventLogGlobal = OpenEventLog(vbNullString, logName)
    If hEventLogGlobal = 0 Then
        lErr = GetLastError()
        MsgBox "イベントログ '" & logName & "' のオープンに失敗しました。エラーコード: " & lErr, vbCritical
        Exit Sub
    End If

    ' 最後のレコード番号を初期化 (初回実行時やリセット時)
    ' 実際の運用では、永続化された値 (例: シートのセル) から読み込む
    If lLastRecordNumber = 0 Then
        ' ログの現在の最終レコード番号を取得して初期値とする
        ' これにより、開始時以降のイベントのみを処理対象とする
        Dim tempBuffer(0 To 0) As Byte ' 最小バッファ
        Dim tempBytesRead As Long, tempMinBytesNeeded As Long
        Dim tempRecord As EVENTLOGRECORD_FIXED

        ' ログの最後尾から1レコード読み込む (これにより最後のレコード番号が判明する)
        If ReadEventLog(hEventLogGlobal, EVENTLOG_FORWARDS_READ Or EVENTLOG_SEQUENTIAL_READ, 0, tempBuffer(0), 1, tempBytesRead, tempMinBytesNeeded) = 0 Then
            lErr = GetLastError()
            If lErr = 234 Or lErr = 0 Then ' ERROR_INSUFFICIENT_BUFFER またはログ終端
                ' ログが空の場合やバッファ不足の場合、先頭から読み込むように lLastRecordNumber を 0 のままにする
                lLastRecordNumber = 0 ' または ReadEventLogを再度呼び出して最後のレコードを正確に取得する
                ' 最も確実なのは、イベントを順方向に読み続けて終端に達した時点のレコード番号を記録する方法だが、
                ' ここでは簡略化し、単純にReadEventLogがSUCCESSを返した最後のレコード番号を保持する。
                ' または、ログにイベントが全くない場合はlLastRecordNumber=0のままにしておく。
                ' 本実装では、ReadEventLogが0を返してもエラーコードが0ならログ終端と判断し、
                ' その後ReadNewEventsで実際のイベントを読み込む。
                ' StartEventLogMonitor開始時のlLastRecordNumberは、前回停止時の値か、初めてなら0
                ' 実際にイベントがあった場合は、ReadNewEventsでlLastRecordNumberが更新される。
            Else
                MsgBox "最終レコード番号の取得に失敗しました。エラーコード: " & lErr, vbCritical
                Call CloseEventLog(hEventLogGlobal)
                Exit Sub
            End If
        End If
    End If

    ' これ以降、StartEventLogMonitorの呼出し時には既にhEventLogGlobalがオープンされているため
    ' この部分はコメントアウト、または別の方法で最終レコード番号を取得する
    ' 最も簡単なのは、ReadNewEvents内でlLastRecordNumberが0の場合は、ログの現在の最新レコード番号を取得するロジックを追加すること

    fMonitoringActive = True
    Call ScheduleNextMonitoring(intervalSeconds)
    MsgBox "イベントログ監視を開始しました。ログ: " & logName & ", 間隔: " & intervalSeconds & "秒", vbInformation
End Sub

'---------------------------------------------------------------------------------------------------
' サブルーチン名: StopEventLogMonitor
' 概要: Windowsイベントログのポーリング監視を停止します。
' 前提: Win32 APIのDeclare文、グローバル変数 hEventLogGlobal, fMonitoringActive が宣言されていること。
'---------------------------------------------------------------------------------------------------
Public Sub StopEventLogMonitor()
    If Not fMonitoringActive Then
        MsgBox "イベントログ監視は実行されていません。", vbInformation
        Exit Sub
    End If

    fMonitoringActive = False
    Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), Procedure:="MonitorEventLogPolling", Schedule:=False

    If hEventLogGlobal <> 0 Then
        Call CloseEventLog(hEventLogGlobal)
        hEventLogGlobal = 0
    End If

    MsgBox "イベントログ監視を停止しました。", vbInformation
End Sub

'---------------------------------------------------------------------------------------------------
' サブルーチン名: ScheduleNextMonitoring
' 概要: 次のポーリング実行をスケジュールします。
' 引数:
'   intervalSeconds (Long): ポーリング間隔 (秒単位)
'---------------------------------------------------------------------------------------------------
Private Sub ScheduleNextMonitoring(ByVal intervalSeconds As Long)
    If fMonitoringActive Then
        Application.OnTime EarliestTime:=Now + TimeSerial(0, 0, intervalSeconds), _
                           Procedure:="MonitorEventLogPolling", _
                           Schedule:=True
    End If
End Sub

'---------------------------------------------------------------------------------------------------
' サブルーチン名: MonitorEventLogPolling
' 概要: 定期的に呼び出され、新しいイベントログをチェックし処理します。
' 備考:
'   - このサブルーチンはApplication.OnTimeによって呼び出されます。
'   - ログへの書き込み時にScreenUpdatingを一時的に停止し、性能を向上させます。
'---------------------------------------------------------------------------------------------------
Public Sub MonitorEventLogPolling()
    Dim byteBuffer() As Byte
    Dim nBytesRead As Long
    Dim nMinBytesNeeded As Long
    Dim lRet As Long
    Dim lErr As Long

    Dim currentBufferPos As Long
    Dim currentRecord As EVENTLOGRECORD_FIXED
    Dim sName As String, cName As String

    Dim ws As Worksheet
    Dim rowNum As Long

    ' 監視が停止している場合は何もしない
    If Not fMonitoringActive Then Exit Sub

    ' 性能チューニング開始
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual ' 計算モードを手動に設定 (Excelの場合)

    On Error GoTo ErrorHandler

    ' ログ出力シートを決定 (初回のみ作成、以降は既存シートに追記)
    On Error Resume Next ' シート存在チェックのため
    Set ws = ThisWorkbook.Sheets("監視イベントログ")
    On Error GoTo ErrorHandler
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = "監視イベントログ"
        ws.Cells(1, 1).Value = "レコード番号"
        ws.Cells(1, 2).Value = "日時"
        ws.Cells(1, 3).Value = "イベントID"
        ws.Cells(1, 4).Value = "タイプ"
        ws.Cells(1, 5).Value = "ソース"
        ws.Cells(1, 6).Value = "コンピューター"
        ws.Rows(1).Font.Bold = True
        ws.Columns("A:F").AutoFit
        rowNum = 2 ' データは2行目から
    Else
        ' 既存シートの最終行を取得して追記
        rowNum = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    End If

    ' バッファの初期サイズ
    ReDim byteBuffer(0 To 65535 - 1) ' 64KB

    ' 前回読み込んだレコード番号以降のイベントを読み込む
    ' EVENTLOG_FORWARDS_READ | EVENTLOG_SEQUENTIAL_READ を使用し、
    ' dwRecordOffset に lLastRecordNumber + 1 を指定すると、そのレコード以降が読み込まれる
    ' ただし、ReadEventLogのdwRecordOffsetはEVENTLOG_SEQUENTIAL_READと同時に指定された場合、
    ' ReadEventLogは無視するという仕様があるため、ここでは ReadEventLog を複数回呼び出し、
    ' 読み込んだレコードのRecordNumberでフィルタリングする方式にする。
    ' これは、ReadEventLogが指定レコード番号から読み始めるという保証がないため、より安全なアプローチ。

    Dim lastReadRecordNum As Long ' 今回のReadEventLogで読み込んだ最後のレコード番号
    Dim newEventsFound As Boolean

    Do
        lRet = ReadEventLog(hEventLogGlobal, EVENTLOG_FORWARDS_READ Or EVENTLOG_SEQUENTIAL_READ, 0, _
                            byteBuffer(0), UBound(byteBuffer) + 1, nBytesRead, nMinBytesNeeded)

        If lRet = 0 Then
            lErr = GetLastError()
            If lErr = 234 Then ' ERROR_INSUFFICIENT_BUFFER
                ' バッファ再割り当てはパフォーマンスへの影響が大きいため、ここでは最大バッファで固定運用するか、
                ' または、十分なバッファサイズを持つように初期設計する。
                ' 簡略化のため、このエラーはログの終端と見なすか、大きいバッファを推奨。
                ' Debug.Print "バッファが不足しました。必要なバイト数: " & nMinBytesNeeded
                Exit Do
            ElseIf lErr = 0 Then ' ログの終端に到達 (読み込むイベントがもうない)
                Exit Do
            Else
                MsgBox "イベントログの読み込みに失敗しました。エラーコード: " & lErr, vbCritical
                GoTo ErrorHandler
            End If
        End If

        currentBufferPos = 0
        Do While currentBufferPos < nBytesRead
            ' 固定長部分をコピー
            CopyMemory currentRecord, byteBuffer(currentBufferPos), Len(currentRecord)

            ' レコードの総バイト数が取得済みバイト数を超えないことを確認
            If currentBufferPos + currentRecord.Length > nBytesRead Then Exit Do

            ' 処理対象のイベントかチェック (lLastRecordNumberより新しいもののみ)
            If currentRecord.RecordNumber > lLastRecordNumber Then
                newEventsFound = True
                ' ワークシートに書き出す
                With ws
                    .Cells(rowNum, 1).Value = currentRecord.RecordNumber
                    .Cells(rowNum, 2).Value = DateAdd("s", currentRecord.TimeGenerated, #1/1/1970#)
                    .Cells(rowNum, 3).Value = currentRecord.EventID And &HFFFF&
                    .Cells(rowNum, 4).Value = GetEventTypeString(currentRecord.EventType)

                    If currentRecord.SourceNameOffset > 0 Then
                        sName = ExtractStringFromBuffer(byteBuffer, currentBufferPos + currentRecord.SourceNameOffset)
                        .Cells(rowNum, 5).Value = sName
                    Else
                        .Cells(rowNum, 5).Value = ""
                    End If

                    If currentRecord.ComputerNameOffset > 0 Then
                        cName = ExtractStringFromBuffer(byteBuffer, currentBufferPos + currentRecord.ComputerNameOffset)
                        .Cells(rowNum, 6).Value = cName
                    Else
                        .Cells(rowNum, 6).Value = ""
                    End If

                    ' ここにカスタムのイベント処理ロジックを追加 (例: 特定のIDでアラートを出す)
                    ' If currentRecord.EventID = 100 Then Debug.Print "特定イベント検出！"

                    rowNum = rowNum + 1
                End With
                lLastRecordNumber = currentRecord.RecordNumber ' 最終レコード番号を更新
            End If

            lastReadRecordNum = currentRecord.RecordNumber ' ReadEventLogで読み込んだ最後のレコード番号を記録
            currentBufferPos = currentBufferPos + currentRecord.Length
        Loop
        ' ReadEventLogが読み込んだデータは、常に前回の続きからになるため、
        ' このループはバッファ内のすべてのイベントを処理し終えたら終了する。
        ' 次のReadEventLog呼び出しは、引き続き次からのイベントを読み込む。
        ' lLastRecordNumber は実際に処理したイベントの最大レコード番号を保持する。
        If currentBufferPos < nBytesRead Then Exit Do ' バッファが全て消費されなかった場合は、次回の読み込みは不要
    Loop While nBytesRead > 0 ' 読み込むデータがなくなるまでループ

    If newEventsFound Then
        ws.Columns("A:F").AutoFit ' 新しいイベントがあれば列幅を自動調整
        ' 最終レコード番号を永続化する場合、ここでシートに書き込むなど
    End If

Exit_Function:
    ' 次のポーリングをスケジュール
    Call ScheduleNextMonitoring(10) ' 例えば10秒間隔

    ' 性能チューニング終了
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "イベントログ監視中にエラーが発生しました: " & Err.Description, vbCritical
    Call StopEventLogMonitor ' エラー発生時は監視を停止
    Resume Exit_Function
End Sub

' 使用例
Sub Sample_StartMonitoring()
    ' "Application" ログを 10 秒間隔で監視開始
    Call StartEventLogMonitor("Application", 10)
End Sub

Sub Sample_StopMonitoring()
    Call StopEventLogMonitor
End Sub

' Accessでのタイマーイベントの利用例 (ExcelのApplication.OnTimeの代替)
' Accessの場合、フォームのLoadイベントなどで
' Me.TimerInterval = 10000 ' 10秒 (ミリ秒単位)
' そしてフォームのTimerイベントに MonitorEventLogPolling を呼び出す処理を記述
' Private Sub Form_Timer()
'     If fMonitoringActive Then Call MonitorEventLogPolling
' End Sub
' Form_Closeイベントで Me.TimerInterval = 0 と StopEventLogMonitor を呼び出す

性能チューニング

VBAで大量のデータ処理やUI操作を伴う場合、以下のチューニングは必須です。

  1. 画面更新の停止: Application.ScreenUpdating = False を処理開始時に設定し、終了時に True に戻します。これにより、ワークシートへの書き込みに伴う画面描画が抑制され、処理速度が大幅に向上します。

    • 効果例: 10,000行のデータ書き込みで、通常約5秒かかる処理が、画面更新停止により約0.5秒に短縮されることがあります。

  2. 計算モードの手動設定: Excelで数式が多く含まれるワークシートに書き込む場合、Application.Calculation = xlCalculationManual を設定し、自動再計算を停止します。

    • 効果例: 大量のセルにデータを書き込む際に、自動計算によるオーバーヘッドが削減され、処理時間を最大80%短縮できることがあります。

  3. 配列バッファの活用: Win32 APIから読み込んだイベントデータや、処理後のデータを直接ワークシートに1行ずつ書き込むのではなく、一旦VBAの配列に格納し、全ての処理が完了した後に配列ごとワークシートに一括で書き込みます。

    • 効果例: 10,000件のイベントログを個別に書き込むと数秒〜数十秒かかる場合でも、配列経由の一括書き込みで1秒未満に短縮することが可能です。

  4. DoEvents の適切な利用: ポーリングのような長時間のループ処理では、DoEvents を適度な頻度で呼び出すことで、VBAが他のイベント（UI操作など）を処理する機会を与え、アプリケーションのフリーズを防ぎます。ただし、頻繁な呼び出しはオーバーヘッドを増やすため、バランスが重要です。ポーリング間隔の Sleep で代替することもできます。

検証

実行手順

  1. VBAプロジェクトの準備:

    • ExcelまたはAccessを開き、Alt + F11 を押してVBAエディターを起動します。

    • 「挿入」メニューから「標準モジュール」を選択し、新しいモジュールを作成します。

    • 上記「実装」セクションのWin32 API宣言、構造体、および2つのコード例（ReadRecentEventLogs とポーリング関連）をすべて新しいモジュールにコピー＆ペーストします。

  2. イベントログの発生: 任意で、Windowsのイベントビューアー（eventvwr.msc）を開き、「Windowsログ」->「アプリケーション」または「システム」ログを確認します。テストのために、意図的にイベントを発生させても良いでしょう（例: テスト用スクリプトの実行、存在しないファイルをアクセスする、など）。

  3. 一括読み込みの検証:

    • VBAエディターで Sample_ReadRecentEventLogs プロシージャを選択し、F5 キーを押して実行します。

    • 新しいワークシートが作成され、指定したログの最新イベントが一覧表示されることを確認します。

  4. ポーリング監視の検証:

    • VBAエディターで Sample_StartMonitoring プロシージャを選択し、F5 キーを押して実行します。監視開始メッセージが表示されます。

    • 数秒後、新しいワークシート「監視イベントログ」が作成され、新しいイベントが追記されていくことを確認します。

    • この間に、意図的に新しいイベントを発生させると（例: メモ帳を開いてファイルを保存する、または簡単なVBScript/PowerShellを実行してログを生成する）、そのイベントがシートに追記されることを確認します。

    • 監視を停止するには Sample_StopMonitoring プロシージャを実行します。

期待される結果

  • ReadRecentEventLogs 実行後、新しいワークシートが作成され、指定ログの最新N件のイベント（レコード番号、日時、イベントID、タイプ、ソース、コンピューター名）が正確に表示される。

  • StartEventLogMonitor 実行後、新しいワークシート「監視イベントログ」が作成され、その後発生した新しいイベントが定期的に追記されていく。

  • StopEventLogMonitor 実行後、監視が停止し、それ以上イベントが追記されない。

  • イベントのタイムスタンプはUTCからJST（日本の標準時）に変換されていること。(DateAdd("s", currentRecord.TimeGenerated, #1/1/1970#) はVBAの内部時間変換に依存するため、システムのタイムゾーン設定に準拠します)

運用

定期実行と自動化

  • Excel: Application.OnTime はExcelが起動している間のみ機能します。Excelファイルを閉じると監視は停止します。Excelを常時起動させるか、タスクスケジューラから定期的にExcelファイルを開いてマクロを実行するよう設定することで、自動化が可能です。

  • Access: フォームの Timer イベントと TimerInterval プロパティを利用することで、フォームが開いている間は定期的に監視を実行できます。データベースを開いた際に自動で監視フォームを開くように設定することも可能です。

  • エラーハンドリング: 運用中にAPI呼び出しが失敗した場合に備え、On Error GoTo ErrorHandler を適切に配置し、エラーメッセージのログ出力や管理者に通知する機能を追加することが望ましいです。

ロールバック方法

VBAマクロのロールバックは比較的簡単です。

  1. VBAモジュールの削除: VBAエディターで、作成した標準モジュールを右クリックし、「Module1の削除」（または作成したモジュール名）を選択します。エクスポートを促されたら「いいえ」を選択します。

  2. 作成されたワークシートの削除: 監視によって作成されたワークシート（例: 「Applicationログ_yyyymmdd_hhmmss」、「監視イベントログ」）を手動で削除します。

  3. VBAプロジェクトのリセット: 極端な場合、VBAプロジェクト全体をリセットするために、ブック/データベースを保存せずに閉じる、またはバックアップから復元することも可能です。ただし、本ソリューションは既存のVBAプロジェクトに大きな変更を加えないため、通常は上記1, 2で十分です。

落とし穴と注意点

権限問題

イベントログ（特にSecurityログ）の読み取りには管理者権限が必要です。Officeアプリケーションが管理者権限で実行されていない場合、OpenEventLog が失敗し、GetLastError がアクセス拒否のエラー（通常5: ERROR_ACCESS_DENIED）を返します。VBA自体では権限昇格はできません。

パフォーマンス（大量ログ）

  • バッファサイズ: ReadEventLog は指定されたバッファサイズで可能な限り多くのイベントを読み込みます。バッファが小さすぎると頻繁なAPI呼び出しが必要になり、大きすぎるとメモリを浪費します。適切なバッファサイズ（例: 64KB〜256KB）の選択が重要です。

  • 解析処理: EVENTLOGRECORD の可変長部分の解析（特に複数の文字列の抽出）はバイト操作を伴うため、イベント数が増えると処理負荷が高まります。FormatMessage APIを使えばメッセージ文字列の抽出は簡素化できますが、これには適切なメッセージDLLのロードが必要で、VBAでの実装はさらに複雑になります。本記事では簡単な文字列抽出に留めています。

  • ポーリング間隔: ポーリング間隔が短すぎるとシステムリソースを消費しすぎ、長すぎるとイベントの検知が遅れます。システムの負荷と監視要件に応じて適切な間隔を設定する必要があります。

メモリ管理

  • VBAはガベージコレクションを自動で行いますが、byteBuffer のような大きな配列を頻繁に ReDim したり、大量の EventLogEntry オブジェクトをメモリ上に保持したりすると、メモリ消費量が増加する可能性があります。不要になった配列は Erase で解放し、オブジェクトは Set obj = Nothing で明示的に解放することが推奨されます。

  • OpenEventLog で取得したハンドルは、必ず CloseEventLog で解放する必要があります。解放を怠ると、ハンドルリークが発生し、システムリソースを枯渇させる可能性があります。

マルチスレッドの限界

VBAはシングルスレッドで動作するため、真のバックグラウンド監視や非同期処理はできません。Application.OnTime は、指定された時間にメインスレッドでマクロを実行するだけです。マクロ実行中はUIがブロックされる可能性があります。DoEvents を適切に挟むことで、UIの応答性を保つことは可能ですが、完全なマルチスレッドアプリケーションのような挙動は期待できません。

イベントメッセージの詳細解析の難しさ

EVENTLOGRECORD の StringInserts フィールドには、イベントメッセージを構成するためのパラメータ文字列が含まれています。これらの文字列を使って完全なイベントメッセージを再構築するには、イベントソースに対応するメッセージDLL (.dll または .exe) を特定し、FormatMessage APIを適切に呼び出す必要があります。このプロセスはVBAで実装するには非常に高度であり、イベントソースによってDLLが異なるため汎用的な実装は困難です。そのため、本記事のコード例では EventID や SourceName といった基本情報に焦点を当てています。

まとめ

本記事では、VBAとWin32 APIを組み合わせることで、外部ライブラリに依存せずにWindowsイベントログを監視する実用的なソリューションを提供しました。具体的には、最新イベントの一括読み込みと、ポーリングによる新規イベントの監視という2つの実装例を示し、Excelワークシートへの出力方法を解説しました。

VBAの特性上、真のリアルタイム通知は困難ですが、適切なポーリング間隔とパフォーマンスチューニングを施すことで、実務レベルで十分機能する監視システムを構築することが可能です。イベントログの基本的な情報だけでなく、EventIDやSourceNameを用いたフィルタリング、そして特定のイベントに対する自動アクション（例: メール通知、別アプリケーションの起動）といった拡張機能を加えることで、より高度なOffice自動化に貢献できるでしょう。

ただし、権限管理、大量ログのパフォーマンス、メモリ管理、そしてイベントメッセージの複雑な解析といった「落とし穴」にも注意を払い、安定した運用を目指す必要があります。これらの制約を理解した上で、VBAによるイベントログ監視機能を活用してください。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました