' // イベントコード 6005, 6006 を取得します
Sub SampleProc()
Const wbemFlagReturnImmediately As Long = &H10
Const wbemFlagForwardOnly As Long = &H20
Dim Service As Object
Dim EventList As Object
Dim Obj As Object
Dim sComputer As String
Dim lFlags As Long
Dim Sql As String
Dim i As Long
' On Error Resume Next
sComputer = "."
lFlags = wbemFlagReturnImmediately Or wbemFlagForwardOnly
Sql = ""
Sql = Sql & "SELECT *"
Sql = Sql & " FROM Win32_NTLogEvent"
Sql = Sql & " WHERE Logfile = 'System'" _
& " AND EventCode = 6005 OR EventCode = 6006"
Set Service = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate,(Security)}!\\" _
& sComputer & "\root\cimv2")
Set EventList = Service.ExecQuery(Sql, iFlags:=lFlags)
' 出力
Cells.Clear
Range("A1:D1").Value = Array("Code", "DateTime", "Computer", "Message")
i = 2
For Each Obj In EventList
Cells(i, "A").Value = Obj.EventCode
Cells(i, "B").Value = Obj.TimeGenerated ' yyyymmddhhmmss.0000・・・形式です
Cells(i, "C").Value = Obj.ComputerName
Cells(i, "D").Value = Replace$(Obj.Message, vbCrLf, "")
i = i + 1
Next
Columns("A:D").AutoFit
Set EventList = Nothing
Set Service = Nothing
End Sub
