VBAでWindowsイベントログを読み込む

Tech

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

VBAでWindowsイベントログを読み込む

背景と要件

Windowsイベントログは、システムのセキュリティ、アプリケーションの動作、およびハードウェアの健全性に関する重要な情報を提供する中央リポジトリです。通常、これらのログはイベントビューアを通じて確認されますが、特定のイベントを自動的に監視、分析、またはレポートする必要がある場合、手動での確認は非効率的です。 、Microsoft ExcelまたはAccessのVBA（Visual Basic for Applications）を用いて、このWindowsイベントログをプログラム的に読み込む方法を解説します。外部ライブラリに依存せず、Win32 APIを直接呼び出すことで、柔軟かつセキュアなソリューションを構築することを目標とします。具体的には、以下の要件を満たすコードを提供します。

  • 外部ライブラリ不使用: Win32 APIをDeclare PtrSafeで宣言し、直接呼び出す。

  • 再現可能なコード: Excel/Accessを対象に、実務レベルで利用可能なコードを少なくとも2本提供。

  • 性能チューニング: 大量のイベントログを効率的に処理するための考慮事項と、その数値的な目安を提示。

  • 視覚的説明: 処理の流れやデータモデルをMermaid図で説明。

  • 詳細な手順: 実行手順とロールバック方法を明確にする。

  • 文字数: 1200文字以上。

設計

処理フロー

WindowsイベントログをVBAで読み込む基本的な処理フローは、以下のステップで構成されます。

flowchart TD
    A["開始"] --> B{"イベントログのオープン"};
    B -- イベントログ名指定 --> C["OpenEventLog API"];
    C -- ログハンドル取得 --> D{"ログレコードの読み込みループ"};
    D -- 読み込みフラグ指定, バッファ用意 --> E["ReadEventLog API"];
    E -- レコードデータ取得 --> F{"EVENTLOGRECORD構造体の解析"};
    F -- メッセージID, ソース名取得 --> G["FormatMessage API"];
    G -- フォーマット済みメッセージ取得 --> H["イベントデータ抽出/保存"];
    H -- 繰り返し? --> D;
    D -- 終了条件達成 --> I{"イベントログのクローズ"};
    I -- ログハンドル解放 --> J["CloseEventLog API"];
    J --> K["終了"];

解説:

  1. OpenEventLog API: 読み込みたいイベントログ（例: “System”, “Application”, “Security”）を指定して開きます。成功するとログハンドルが返されます。

  2. ReadEventLog API: オープンしたログハンドルと読み込みフラグ（例: 新しいものから、古いものから）を指定して、イベントレコードをバッファに読み込みます。この関数は一度に複数のレコードを読み込むことが可能です。

  3. EVENTLOGRECORD構造体の解析: ReadEventLogで読み込んだバイトデータから、VBAで定義したEVENTLOGRECORD_TYPE構造体を用いて個々のイベントレコードの情報を抽出します。

  4. FormatMessage API: イベントのメッセージは通常、メッセージIDと関連するDLLによって定義されています。FormatMessage APIを使用することで、これらのIDから人間が読める形式のメッセージ文字列を生成できます。

  5. データ抽出/保存: 抽出したイベント情報をVBAのコレクションや配列、またはExcelシート、Accessテーブルに保存します。

  6. CloseEventLog API: 全ての処理が完了したら、取得したログハンドルを解放します。

データモデルとAPI

イベントログの各レコードはEVENTLOGRECORD構造体として定義されます。VBAでは、これをTypeステートメントで定義します。

' EVENTLOGRECORD構造体のVBAでの定義 (32bit/64bit対応のためLongPtrを使用)
Type EVENTLOGRECORD_TYPE
    dwSize          As Long     ' イベントレコードのバイトサイズ
    dwReserved      As Long     ' 予約 (0x454C464C - ELF)
    dwRecordNumber  As Long     ' レコード番号
    ftTimeGenerated As FILETIME ' イベントが生成された時間
    ftTimeWritten   As FILETIME ' イベントがログに書き込まれた時間
    dwEventID       As Long     ' イベントID
    dwEventType     As Integer  ' イベントタイプ (例: エラー、警告)
    wNumStrings     As Integer  ' イベントメッセージ内の文字列数
    wReservedFlags  As Integer  ' 予約
    dwEventCategory As Integer  ' イベントカテゴリ
    wSourceNameOffset As Integer ' ソース名文字列へのオフセット
    wComputerNameOffset As Integer ' コンピュータ名文字列へのオフセット
    dwStringOffset  As Long     ' 最初のメッセージ文字列へのオフセット (32bit:Integer, 64bit:Long)
    dwUserSidLength As Long     ' ユーザーSIDの長さ
    dwUserSidOffset As Long     ' ユーザーSIDへのオフセット
    dwDataLength    As Long     ' イベント固有データの長さ
    dwDataOffset    As Long     ' イベント固有データへのオフセット
End Type

' FILETIME構造体 (64bit時間を表現)
Type FILETIME
    dwLowDateTime   As Long
    dwHighDateTime  As Long
End Type

Win32 APIの宣言: VBAのDeclare PtrSafeキーワードを使用して、64ビット版Officeでも正しく動作するようにAPI関数を宣言します。

  • OpenEventLog: イベントログへのハンドルを取得。

  • ReadEventLog: イベントログレコードを読み込む。バッファと読み込みバイト数を指定。

  • CloseEventLog: イベントログハンドルを解放。

  • FormatMessage: イベントメッセージIDとソースから人間が読めるメッセージ文字列を生成。

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

  • CopyMemory: バイト配列から構造体へ、またはその逆へデータをコピー。（VBAではRtlMoveMemoryを使用することもある）

実装

コード1: 基本的なイベントログの読み込みと表示 (Excel/Access共通)

このコードは、指定されたイベントログから最新の50件のイベントを読み込み、主要な情報をDebug.Printウィンドウに表示します。FormatMessageを使用してイベントメッセージを生成します。

' Win32 APIの宣言
#If VBA7 Then

    Private Declare PtrSafe Function OpenEventLog Lib "advapi32.dll" Alias "OpenEventLogA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As LongPtr
    Private Declare PtrSafe Function ReadEventLog Lib "advapi32.dll" Alias "ReadEventLogA" (ByVal hEventLog As LongPtr, ByVal dwFlags As Long, ByVal dwOffset As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef pnBytesRead As Long, ByRef pnMinNumberOfBytesNeeded As Long) As Long
    Private Declare PtrSafe Function CloseEventLog Lib "advapi32.dll" (ByVal hEventLog As LongPtr) As Long
    Private Declare PtrSafe Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) As Long
    Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else

    Private Declare Function OpenEventLog Lib "advapi32.dll" Alias "OpenEventLogA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long
    Private Declare Function ReadEventLog Lib "advapi32.dll" Alias "ReadEventLogA" (ByVal hEventLog As Long, ByVal dwFlags As Long, ByVal dwOffset As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef pnBytesRead As Long, ByRef pnMinNumberOfBytesNeeded As Long) As Long
    Private Declare Function CloseEventLog Lib "advapi32.dll" (ByVal hEventLog As Long) As Long
    Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
    Private Declare Function GetLastError Lib "kernel32.dll" () As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If

' イベントログ関連定数
Private Const EVENTLOG_BACKWARDS_READ As Long = &H8 ' 最新から古い方向へ読み込む
Private Const EVENTLOG_SEQUENTIAL_READ As Long = &H1 ' 順次読み込み (ReadEventLogが呼び出されるたびに進む)

' FormatMessage関連定数
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200 ' 引数%n!s!を無視 (簡易化のため)
Private Const FORMAT_MESSAGE_MAX_STRING_LENGTH As Long = 2048 ' メッセージバッファの最大長

' EVENTLOGRECORD構造体
Private Type FILETIME
    dwLowDateTime   As Long
    dwHighDateTime  As Long
End Type

Private Type EVENTLOGRECORD_TYPE
    dwSize          As Long
    dwReserved      As Long
    dwRecordNumber  As Long
    ftTimeGenerated As FILETIME
    ftTimeWritten   As FILETIME
    dwEventID       As Long
    dwEventType     As Integer
    wNumStrings     As Integer
    wReservedFlags  As Integer
    dwEventCategory As Integer
    wSourceNameOffset As Integer
    wComputerNameOffset As Integer
    dwStringOffset  As Long ' 32bitと64bitでオフセットが変わる可能性 (PtrSafeのLenBで調整)
    dwUserSidLength As Long
    dwUserSidOffset As Long
    dwDataLength    As Long
    dwDataOffset    As Long
End Type

' FILETIMEからDateへの変換関数
Private Function FileTimeToDate(ByRef ft As FILETIME) As Date
    Dim varDate As Variant
    Dim ull As Currency ' 64ビット整数を扱うためCurrencyを使用

    ull = ft.dwHighDateTime
    ull = ull * &H100000000 + ft.dwLowDateTime ' 64ビット値を構築
    ull = ull / 10000000# ' 100ナノ秒単位を秒単位に変換
    ull = ull / 86400# ' 秒単位を日単位に変換

    ' 1899年12月30日 (UTC) がVBAのDateの基準日 (0)
    ' Windowsファイル時間は1601年1月1日 (UTC) が基準日 (0)
    ' 1899年12月30日から1601年1月1日までの日数は109205日
    ' 1899年12月30日から1601年1月1日までの秒数は9223372036854775807 / 10000000 / 86400
    ' Excel date (1899/12/30) = Windows file time (1601/01/01) + 109205 days.
    FileTimeToDate = CDate(ull - 109205#) ' 基準日オフセット調整
End Function


Sub ReadLatestEventLogs()
    Const LOG_NAME As String = "System" ' "Application", "Security" など
    Const MAX_EVENTS_TO_READ As Long = 50 ' 読み込むイベントの最大数

    #If VBA7 Then

        Dim hEventLog As LongPtr
    #Else

        Dim hEventLog As Long
    #End If

    Dim lBufferSize As Long
    Dim bytBuffer() As Byte
    Dim lBytesRead As Long
    Dim lMinBytesNeeded As Long
    Dim lResult As Long
    Dim lCurrentPos As Long
    Dim i As Long
    Dim rec As EVENTLOGRECORD_TYPE
    Dim sSourceName As String
    Dim sComputerName As String
    Dim sMessage As String
    Dim lMsgFlags As Long

    ' イベントログを開く (ローカルマシンはvbNullString)
    hEventLog = OpenEventLog(vbNullString, LOG_NAME)
    If hEventLog = 0 Then
        Debug.Print "イベントログ '" & LOG_NAME & "' のオープンに失敗しました。エラーコード: " & GetLastError()
        Exit Sub
    End If

    ' バッファの初期サイズを設定 (一度に読み込むバイト数)
    ' EVENTLOGRECORD_TYPEのサイズは固定ではないため、大きめに見積もる
    lBufferSize = 65536 ' 64KB

    ReDim bytBuffer(1 To lBufferSize) ' 1ベース配列として初期化

    Debug.Print "--- Windowsイベントログ '" & LOG_NAME & "' から最新 " & MAX_EVENTS_TO_READ & " 件を読み込み中 ---"
    i = 0
    lCurrentPos = 1 ' バッファ内の現在の位置

    ' 最新から古い方向に順次読み込む
    Do While ReadEventLog(hEventLog, EVENTLOG_BACKWARDS_READ Or EVENTLOG_SEQUENTIAL_READ, 0, bytBuffer(1), lBufferSize, lBytesRead, lMinBytesNeeded) <> 0 And i < MAX_EVENTS_TO_READ
        If lBytesRead = 0 Then Exit Do ' 読み込むデータがない

        lCurrentPos = 1 ' バッファの先頭から処理開始
        Do While lCurrentPos <= lBytesRead
            ' バッファからEVENTLOGRECORD_TYPE構造体にコピー
            ' CopyMemoryは0ベースのバイト配列を期待するため、ポインタ調整
            CopyMemory rec, bytBuffer(lCurrentPos), LenB(rec)

            ' オフセットはEVENTLOGRECORDの開始位置からの相対
            sSourceName = GetStringFromBuffer(bytBuffer, lCurrentPos + rec.wSourceNameOffset, lBytesRead)
            sComputerName = GetStringFromBuffer(bytBuffer, lCurrentPos + rec.wComputerNameOffset, lBytesRead)

            ' FormatMessageフラグを設定
            ' イベントソースからメッセージを読み込むためにFORMAT_MESSAGE_FROM_HMODULEを使用する場合がある
            ' 今回は簡易的にFORMAT_MESSAGE_FROM_SYSTEMと引数無視
            lMsgFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS

            ' FormatMessageでメッセージを取得
            Dim sMsgBuffer As String
            sMsgBuffer = String(FORMAT_MESSAGE_MAX_STRING_LENGTH, Chr$(0)) ' NULL終端文字列のため
            lResult = FormatMessage(lMsgFlags, 0&, rec.dwEventID, 0&, sMsgBuffer, FORMAT_MESSAGE_MAX_STRING_LENGTH, 0&)

            If lResult > 0 Then
                sMessage = Left$(sMsgBuffer, lResult)
            Else
                sMessage = "メッセージの取得に失敗しました。イベントID: " & rec.dwEventID & ", エラーコード: " & GetLastError()
            End If

            ' 情報を表示
            Debug.Print "----------------------------------------"
            Debug.Print "レコード番号: " & rec.dwRecordNumber
            Debug.Print "生成日時: " & FileTimeToDate(rec.ftTimeGenerated)
            Debug.Print "ソース: " & sSourceName
            Debug.Print "コンピュータ名: " & sComputerName
            Debug.Print "イベントID: " & (rec.dwEventID And &HFFFF&) ' 下位16ビットのみ表示
            Debug.Print "イベントタイプ: " & GetEventTypeString(rec.dwEventType)
            Debug.Print "メッセージ: " & sMessage

            i = i + 1
            If i >= MAX_EVENTS_TO_READ Then Exit Do ' 指定件数に達したら終了

            ' 次のレコードへ移動 (dwSizeは現在のレコードの全長)
            lCurrentPos = lCurrentPos + rec.dwSize
            ' 配列のサイズが小さすぎる場合、CopyMemoryで例外が発生する可能性
            If lCurrentPos + LenB(rec) > lBufferSize Then Exit Do ' 次のレコードがバッファを超えるなら、次のReadEventLogへ
        Loop
    Loop

    ' イベントログをクローズ
    CloseEventLog hEventLog

    Debug.Print "--- イベントログの読み込み完了 ---"
End Sub

' バッファからNULL終端文字列を抽出するヘルパー関数
Private Function GetStringFromBuffer(ByRef bytBuffer() As Byte, ByVal lOffset As Long, ByVal lBytesRead As Long) As String
    Dim lEnd As Long
    Dim lLen As Long
    Dim sResult As String

    ' オフセットがバッファの範囲内か確認
    If lOffset <= 0 Or lOffset > lBytesRead Then Exit Function

    lEnd = lOffset
    ' NULL文字 ('A'の場合 Chr$(0)) を探す
    Do While lEnd <= lBytesRead
        If bytBuffer(lEnd) = 0 Then Exit Do
        lEnd = lEnd + 1
    Loop

    lLen = lEnd - lOffset
    If lLen > 0 Then
        ' バイト配列を文字列に変換 (ANSIを想定)
        GetStringFromBuffer = Left$(StrConv(MidB(bytBuffer, lOffset, lLen), vbUnicode), lLen)
    End If
End Function

' イベントタイプを文字列に変換するヘルパー関数
Private Function GetEventTypeString(ByVal dwEventType As Integer) As String
    Select Case dwEventType
        Case 1: GetEventTypeString = "エラー"
        Case 2: GetEventTypeString = "警告"
        Case 4: GetEventTypeString = "情報"
        Case 8: GetEventTypeString = "監査成功"
        Case 16: GetEventTypeString = "監査失敗"
        Case Else: GetEventTypeString = "不明 (" & dwEventType & ")"
    End Select
End Function

コードの解説:

  • PtrSafeキーワードにより、32ビット版と64ビット版VBAの両方に対応します。

  • ReadEventLogはバイト配列にイベントデータを読み込みます。CopyMemory（RtlMoveMemory）を使用して、バイト配列からEVENTLOGRECORD_TYPE構造体へデータをコピーし、個々のイベント情報を抽出します。

  • FileTimeToDate関数でWindowsファイル時間をVBAの日付型に変換します。

  • FormatMessageはイベントIDから詳細なメッセージ文字列を取得します。システムメッセージだけでなく、特定のアプリケーションのイベントソースDLLを指定することで、より正確なメッセージを取得することも可能です（この例ではシステムメッセージに限定）。

  • GetStringFromBufferヘルパー関数は、バイト配列内のNULL終端文字列を抽出します。

  • GetEventTypeStringヘルパー関数は、イベントタイプコードを分かりやすい文字列に変換します。

コード2: 性能チューニングを考慮した実装

大量のイベントログを読み込む場合、VBAでのループ処理やシートへの直接書き込みはパフォーマンスのボトルネックになりがちです。ここでは、以下の最適化を考慮したコードを示します。

  1. 配列バッファへの一括読み込み: ReadEventLogは一度に複数のイベントレコードを読み込めるため、バッファサイズを適切に設定し、API呼び出し回数を減らします。

  2. VBA内部での処理: 読み込んだデータをExcelシートに直接書き込むのではなく、一旦VBAの配列やCollectionオブジェクトに格納し、処理が完了してから一括してシートに書き込む。

  3. Excel/Accessアプリケーション設定の最適化: (Excelの場合)ScreenUpdating = False、Application.Calculation = xlCalculationManualなどを設定し、UI更新や自動再計算を抑制します。

以下のコードは、上記コード1をベースに、読み込んだイベント情報をCollectionオブジェクトに格納し、必要に応じて利用する形式に拡張しています。Excelシートへの書き込みはコメントアウトしていますが、実際に利用する際は、WriteEventDataToSheetのような関数で一括書き込みを実装します。

Sub ReadLatestEventLogsOptimized()
    Const LOG_NAME As String = "Application"
    Const MAX_EVENTS_TO_READ As Long = 500 ' 読み込むイベントの最大数 (数を増やす)
    Const READ_BUFFER_SIZE As Long = 262144 ' 256KBのバッファで一度に読み込む

    #If VBA7 Then

        Dim hEventLog As LongPtr
    #Else

        Dim hEventLog As Long
    #End If

    Dim bytBuffer() As Byte
    Dim lBytesRead As Long
    Dim lMinBytesNeeded As Long
    Dim lResult As Long
    Dim lCurrentPos As Long
    Dim i As Long
    Dim rec As EVENTLOGRECORD_TYPE
    Dim sSourceName As String
    Dim sComputerName As String
    Dim sMessage As String
    Dim lMsgFlags As Long

    ' イベント情報を格納するコレクション
    Dim colEvents As Collection
    Set colEvents = New Collection

    Dim lStartTime As Long
    Dim lEndTime As Long

    ' ==== 性能チューニング設定 (Excelの場合) ====
    ' #If APP_EXCEL Then ' Excelでの実行時のみ
    '     With Application
    '         .ScreenUpdating = False ' 画面更新を停止
    '         .Calculation = xlCalculationManual ' 自動計算を停止
    '         .EnableEvents = False ' イベントを停止
    '     End With
    ' #End If

    lStartTime = Timer ' 処理開始時刻

    hEventLog = OpenEventLog(vbNullString, LOG_NAME)
    If hEventLog = 0 Then
        Debug.Print "イベントログ '" & LOG_NAME & "' のオープンに失敗しました。エラーコード: " & GetLastError()
        ' #If APP_EXCEL Then Call ResetApplicationSettings ' エラー時も設定を元に戻す
        Exit Sub
    End If

    ReDim bytBuffer(1 To READ_BUFFER_SIZE)

    Debug.Print "--- Windowsイベントログ '" & LOG_NAME & "' から最新 " & MAX_EVENTS_TO_READ & " 件を読み込み中 ---"
    i = 0
    lCurrentPos = 1

    Do While ReadEventLog(hEventLog, EVENTLOG_BACKWARDS_READ Or EVENTLOG_SEQUENTIAL_READ, 0, bytBuffer(1), READ_BUFFER_SIZE, lBytesRead, lMinBytesNeeded) <> 0 And i < MAX_EVENTS_TO_READ
        If lBytesRead = 0 Then Exit Do

        lCurrentPos = 1
        Do While lCurrentPos <= lBytesRead And i < MAX_EVENTS_TO_READ
            ' Ensure enough space for the EVENTLOGRECORD_TYPE structure
            If lCurrentPos + LenB(rec) - 1 > lBytesRead Then
                ' Not enough space for a full record, break from inner loop
                Exit Do
            End If

            CopyMemory rec, bytBuffer(lCurrentPos), LenB(rec)

            ' オフセットはEVENTLOGRECORDの開始位置からの相対
            sSourceName = GetStringFromBuffer(bytBuffer, lCurrentPos + rec.wSourceNameOffset, lBytesRead)
            sComputerName = GetStringFromBuffer(bytBuffer, lCurrentPos + rec.wComputerNameOffset, lBytesRead)

            lMsgFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS

            Dim sMsgBuffer As String
            sMsgBuffer = String(FORMAT_MESSAGE_MAX_STRING_LENGTH, Chr$(0))
            lResult = FormatMessage(lMsgFlags, 0&, rec.dwEventID, 0&, sMsgBuffer, FORMAT_MESSAGE_MAX_STRING_LENGTH, 0&)

            If lResult > 0 Then
                sMessage = Left$(sMsgBuffer, lResult)
            Else
                sMessage = "メッセージの取得に失敗しました。イベントID: " & (rec.dwEventID And &HFFFF&) & ", エラーコード: " & GetLastError()
            End If

            ' イベントデータをCollectionに追加
            Dim eventData As Dictionary ' Scripting.Dictionaryを使用
            Set eventData = CreateObject("Scripting.Dictionary")
            eventData.Add "RecordNumber", rec.dwRecordNumber
            eventData.Add "TimeGenerated", FileTimeToDate(rec.ftTimeGenerated)
            eventData.Add "SourceName", sSourceName
            eventData.Add "ComputerName", sComputerName
            eventData.Add "EventID", (rec.dwEventID And &HFFFF&)
            eventData.Add "EventType", GetEventTypeString(rec.dwEventType)
            eventData.Add "Message", sMessage
            colEvents.Add eventData

            i = i + 1

            lCurrentPos = lCurrentPos + rec.dwSize
        Loop
    Loop

    CloseEventLog hEventLog

    lEndTime = Timer ' 処理終了時刻

    Debug.Print "--- イベントログの読み込み完了 ---"
    Debug.Print "読み込んだイベント数: " & colEvents.Count
    Debug.Print "処理時間: " & (lEndTime - lStartTime) & " 秒"

    ' ===== 取得したデータを処理 (例: Excelシートに一括書き込み) =====
    ' Call WriteEventDataToSheet(colEvents)

    ' #If APP_EXCEL Then Call ResetApplicationSettings ' アプリケーション設定を元に戻す

End Sub

' #If APP_EXCEL Then ' Excelでの実行時のみ
' Private Sub ResetApplicationSettings()
'     With Application
'         .ScreenUpdating = True
'         .Calculation = xlCalculationAutomatic
'         .EnableEvents = True
'     End With
' End Sub

' Private Sub WriteEventDataToSheet(ByRef col As Collection)
'     Dim lRow As Long
'     Dim eventData As Dictionary
'     Dim varHeaders As Variant
'     Dim varOutput() As Variant
'     Dim lCol As Long
'
'     If col.Count = 0 Then Exit Sub
'
'     ' ヘッダーを定義
'     varHeaders = Array("RecordNumber", "TimeGenerated", "SourceName", "ComputerName", "EventID", "EventType", "Message")
'
'     ' 出力用配列をRedim
'     ReDim varOutput(1 To col.Count, 1 To UBound(varHeaders) + 1)
'
'     lRow = 0
'     For Each eventData In col
'         lRow = lRow + 1
'         For lCol = LBound(varHeaders) To UBound(varHeaders)
'             varOutput(lRow, lCol + 1) = eventData(varHeaders(lCol))
'         Next lCol
'     Next eventData
'
'     With ThisWorkbook.Sheets("Sheet1") ' 書き込み先のシート名を指定
'         .Cells.ClearContents ' 既存の内容をクリア
'         .Range("A1").Resize(1, UBound(varHeaders) + 1).Value = varHeaders ' ヘッダーを書き込み
'         .Range("A2").Resize(UBound(varOutput, 1), UBound(varOutput, 2)).Value = varOutput ' データを一括書き込み
'         .Columns.AutoFit ' 列幅を自動調整
'     End With
' End Sub
' #End If

性能チューニングの数値例:

  • ReadEventLogのlBufferSizeを65536バイトから262144バイト（256KB）に増やすことで、API呼び出し回数を約1/4に削減できます。これにより、API呼び出しのオーバーヘッドを減らし、ReadEventLog自体の実行時間を短縮する効果が期待できます。

  • 例えば、1000件のイベントを読み込む場合、バッファサイズが小さいと何十回もReadEventLogを呼び出す必要がありますが、適切なバッファサイズであれば数回で済みます。

  • Collectionへの格納は、Excelシートへの直接書き込みと比較して10倍以上の速度向上が見込めます（イベント数やシートの複雑性による）。例えば、1000件のイベントを個別にセルに書き込むと数秒かかる場合でも、配列に格納して一括書き込みを行えば数十ミリ秒で完了する可能性があります。

検証

実行手順

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

  2. 標準モジュールの挿入: プロジェクトエクスプローラーでVBAProjectを右クリックし、「挿入」→「標準モジュール」を選択します。

  3. コードの貼り付け: 上記「コード1」または「コード2」の内容をモジュールに貼り付けます。

  4. 実行: Sub ReadLatestEventLogs() または Sub ReadLatestEventLogsOptimized() のいずれかのプロシージャ内にカーソルを置き、F5キーを押すか、ツールバーの「実行」ボタンをクリックします。

  5. 結果の確認: VBAエディタの下部にある「イミディエイトウィンドウ」(Ctrl + Gで表示) に、読み込まれたイベント情報が表示されます。

サンプルログの生成 (任意)

テストのためにイベントログを生成したい場合は、コマンドプロンプトでeventcreateコマンドを使用できます。

eventcreate /T ERROR /ID 1000 /L Application /SO MyVBAApp /D "This is a test error message from VBA application."
eventcreate /T INFORMATION /ID 2000 /L Application /SO MyVBAApp /D "Test information event from VBA."

上記コマンドを実行すると、「アプリケーション」ログにMyVBAAppソースでイベントが生成されます。VBAコードのLOG_NAMEを"Application"、MAX_EVENTS_TO_READを十分に大きな値に設定して実行し、これらのテストイベントが読み込まれるか確認してください。

正常系/異常系の確認

  • 正常系: LOG_NAMEに存在するログ名（例: “System”, “Application”）を指定し、Debug.Printにイベント情報が出力されることを確認します。FormatMessageでメッセージが正しく取得されているか、日付が変換されているかを確認します。

  • 異常系:

    • LOG_NAMEに存在しないログ名（例: “NonExistentLog”）を指定し、OpenEventLogが失敗し、エラーメッセージがDebug.Printに出力されることを確認します。

    • lBufferSizeを非常に小さい値（例: LenB(rec)より小さい値）に設定し、ReadEventLogの動作やエラーハンドリングが適切に行われるかを確認します（ただし、これはVBA内部でのエラーハンドリングが難しいため、通常は推奨されません）。

運用

スケジュールされたタスクでの実行

VBAマクロを定期的に実行したい場合、Windowsのタスクスケジューラを利用できます。

  1. Excel/Accessファイルの保存: マクロを記述したExcelまたはAccessファイルを保存します。

  2. タスクスケジューラの設定:

    • 「コントロールパネル」->「管理ツール」->「タスクスケジューラ」を開きます。

    • 「タスクの作成」を選択します。

    • 「全般」タブでタスク名を設定します。

    • 「トリガー」タブで、タスクを実行する日時や頻度を設定します。

    • 「操作」タブで、新しい操作を作成します。「プログラム/スクリプト」にexcel.exeまたはmsaccess.exeのパスを、引数の追加に/r "C:\Path\To\YourFile.xlsm!ModuleName.MacroName"（Excelの場合）または/x MacroName（Accessの場合）のように指定します。

エラーハンドリングとロギング

実運用では、API呼び出しが失敗した場合に適切なエラー処理が必要です。GetLastError()で取得したエラーコードを詳細なメッセージと共にログファイルに書き出すことで、問題発生時のトラブルシューティングが容易になります。

' エラーハンドリングの例
On Error GoTo ErrorHandler

' ... API呼び出し ...
If hEventLog = 0 Then
    Err.Raise 10001, , "OpenEventLog failed with error code: " & GetLastError()
End If
' ...

Exit Sub

ErrorHandler:
    Debug.Print "実行時エラー " & Err.Number & ": " & Err.Description
    ' ファイルへのログ書き出しなど
    If hEventLog <> 0 Then CloseEventLog hEventLog ' エラー時もハンドルを解放
End Sub

セキュリティ考慮事項

  • 権限: イベントログの読み込みには、通常、Administratorsグループのメンバーまたは適切な権限を持つユーザーアカウントが必要です。特に「セキュリティ」ログは、より厳密な権限が求められます。マクロを実行するユーザーアカウントがログへのアクセス権限を持っていることを確認してください。

  • 機密情報: イベントログには機密情報が含まれる場合があります。抽出したデータを保存・転送する際は、情報漏洩に注意し、適切なアクセス制限や暗号化を適用してください。

落とし穴

  • 64ビットVBAの互換性: DeclareステートメントにPtrSafeキーワードを使用しないと、64ビット版Officeでコンパイルエラーまたは実行時エラーが発生します。また、ポインタやハンドルを扱う変数はLongPtr型にする必要があります。

  • バッファサイズの問題: ReadEventLogに渡すバッファbytBuffer()のサイズ(nNumberOfBytesToRead)が不適切だと、イベントレコードを完全に読み込めない、または不完全なデータを処理してしまう可能性があります。lMinNumberOfBytesNeededの値を確認して、必要なバッファサイズを動的に調整することも考慮する必要があります。

  • イベントメッセージの書式設定: FormatMessageは非常に強力ですが、正確なメッセージを取得するためには、イベントソースのDLLパスや引数文字列の解析など、より複雑な処理が必要になる場合があります。FORMAT_MESSAGE_IGNORE_INSERTSを使うと簡易化できますが、メッセージの詳細が失われることがあります。

  • 大量ログのパフォーマンス: ReadEventLogは高速ですが、数百万件に及ぶようなログを一度にすべて読み込むのはVBAの処理能力では非現実的です。特定の期間やタイプのイベントに絞って読み込む、バッチ処理を行うなどの工夫が必要です。

  • NULL終端文字列の処理: Win32 APIはしばしばNULL終端文字列を使用します。VBAのString型はNULL終端ではないため、バイト配列から文字列を抽出する際には、明示的にNULL文字を探して処理する必要があります（GetStringFromBuffer関数の役割）。

まとめ

本記事では、VBAからWin32 APIを直接利用してWindowsイベントログを読み込む方法を詳細に解説しました。Declare PtrSafeを用いた64ビットVBAへの対応、OpenEventLog、ReadEventLog、FormatMessageといった主要APIの利用、EVENTLOGRECORD構造体の解析、そして性能最適化のためのテクニックを紹介しました。

この手法は、セキュリティ監査の自動化、システムエラーのリアルタイム監視、特定のアプリケーションイベントのカスタムレポート作成など、多岐にわたるOffice自動化シナリオで活用できます。外部ライブラリに依存しないため、展開が容易で、高い制御性と安定性を提供します。ただし、Win32 APIの直接操作は低レベルな処理を伴うため、データ構造の理解と慎重なバッファ管理が求められます。適切なエラーハンドリングと性能チューニングを施すことで、実用的なイベントログ監視ツールをVBAで構築することが可能です。

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

コメント

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