直近○回分のイベント発生日時を配列化するFunctionの修正
直近のイベント発生日時を配列化するFunctionの修正
このとき
作成したFunctionについて、対応できるイベントを増やそうとして、いろいろ不具合に気づいたので修正する。
コードへのリンクはコチラ。
１．無意味な判定をやめる
イベントのデータが取得できているかどうかを、
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
で判定しようとしていたが、そもそも該当するイベントがなかったときは、
colLoggedEvents.itemIndex(i)
ここを評価した時点でエラーが出る。
要するに、この判定はまるで無意味だったということになる。
２．イベントのデータが指定した数よりも少なかった場合の対応
たとえば、直近10回分のデータを取得しようとしたのに、データが２個しかなかった、という場合に、
colLoggedEvents.ItemIndex(i)
のところで、
「インデックスが有効範囲にありません。」てやつ。コレクションの要素数を超えているんだから当然だ。
コードの修正
上記１．、２．を踏まえて修正する。
修正前
まず、
Dim i As Integer
Dim tmpDateValues() As Date
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
Set objEvent = colLoggedEvents.itemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.TimeWritten))
tmpDateValues(i) = retTimeWritten
End If
DoEvents
Next
getAnyEventDateTime = tmpDateValues
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
ここの部分のみ取り上げる。
修正後
Dim i As Integer
Dim tmpDateValues() As Date
Dim n As Integer '……(1)'
n = colLoggedEvents.Count
If n = 0 Then '……(2)'
ReDim tmpDateValues(n)
getAnyEventDateTime = tmpDateValues
Exit Function
End If
If n < eventIndex Then eventIndex = n '……(3)'
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1 '……(4)'
Set objEvent = colLoggedEvents.ItemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
tmpDateValues(i) = retTimeWritten
DoEvents
Next
errorHandler: '……(5)'
getAnyEventDateTime = tmpDateValues
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
１．への対応
まず、(1)からの２行
Dim n As Integer n = colLoggedEvents.Count
で、変数 n にcolLoggedEventsのCountプロパティの値をぶち込む。
んで、(2)からの５行
If n = 0 Then ReDim tmpDateValues(n) getAnyEventDateTime = tmpDateValues Exit Function End If
で、n が0のとき、すなわち、該当するイベントがなかった場合の対応をする。
要素数１の配列を返り値にしている。特に何も書き込まなくても、1900年1月0日（1899年12月30日）の0時0分0秒がセットされているみたい。
これで、(1)の問題はクリア。
２．への対応
まず、(3)からの２行
If n < eventIndex Then eventIndex = n ReDim tmpDateValues(0 To eventIndex - 1)
で、取得したデータの数が要求した数よりも少ない場合に対応。
「10回分のデータを寄こせ！」と呼び出しても、n すなわちcolLoggedEventsのCountプロパティの値が、たとえば「2」だったら、eventIndexの値を「2」に書き換えてしまうことでエラーの芽を摘む。
そして、即座にReDim。まあ、ここまでムキになってReDimすることもないのでしょうが。
ここまで来たら、(4)からの６行
For i = 0 To eventIndex - 1 Set objEvent = colLoggedEvents.ItemIndex(i) retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) tmpDateValues(i) = retTimeWritten DoEvents Next
のForループでは、余計な条件判定は不要。
仮にエラーが出たとしても、(5)の
errorHandler: '……(5)' getAnyEventDateTime = tmpDateValues Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing
で、その時点でのtmpDateValuesを返り値として呼び出し元に返すので無問題。
実験
次のコードで呼び出してみる。
Public Sub run()
Call eraseData
Call writeEventDateTime(10, 6008) '……(1)'
End Sub
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
If cnt > 30 Then cnt = 30
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim baseCell As Range
Dim dateValues As Variant
dateValues = getAnyEventDateTime(cnt, ec)
If dateValues(0) = CDate(0) Then _ '……(2)'
MsgBox "該当するデータがありません。": Exit Sub
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To UBound(dateValues) + 1 '……(3)'
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
変えたのは３箇所。
(1)の
Call writeEventDateTime(10, 6008)
では、対象のイベントIDとして6008を指定。
正常にシャットダウンせずに終了、ということらしい。
(2)からの２行（正味１行）
If dateValues(0) = CDate(0) Then _
MsgBox "該当するデータがありません。": Exit Sub
は、該当するイベントデータがなかった場合の対応。
イベントデータが存在しなかった場合、受け取った配列の１番目の要素（インデックス番号「0」の要素）は、日付の初期値のはずなので、この場合はメッセージを表示して終了する。
後は(3)からの３行
For i = 1 To UBound(dateValues) + 1 baseCell.Offset(i, 0).Value = dateValues(i - 1) Next
をこう変えた。Function内部で配列の要素数を変えることがあるので、Uboundで要素数をこの段階で調べる必要がある。
実行結果
10回分要求したが、データは２つしかなかったみたいだ。
ちなみに、第２引数を「7005」にして、
Call writeEventDateTime(10, 6008)
呼び出してみると、
ちゃんとメッセージが表示された。
おわりに
取り扱っているオブジェクトがイメージしにくいものばかりなので、どんなエラーが起こるのか予想しづらいなあ。
今回使用したコード
いちおう、全部載っけときます。
リスト1-1
Public Sub run() Call eraseData Call writeEventDateTime(10, 6008) '///↑第１引数と第２引数を変えれば、いろんなデータを取得して書き込むことができます。' End Sub
リスト1-2
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
If cnt > 30 Then cnt = 30
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
'///対象のワークシート名を「Main」にしています。'
Dim baseCell As Range
Dim dateValues As Variant
dateValues = getAnyEventDateTime(cnt, ec)
If dateValues(0) = CDate(0) Then _
MsgBox "該当するデータがありません。": Exit Sub
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To UBound(dateValues) + 1
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
リスト1-3
Public Sub eraseData()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Sh.Range("WriteInArea").Value = ""
'///データ書き込みセル範囲に「WriteInArea」と名前を付けています。'
End Sub
リスト2-1
'///直近○回分のイベント日時を配列化する'
Public Function getAnyEventDateTime( _
ByVal eventIndex As Integer, _
ByVal eventCode As WindowsEventCode) As Date()
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As SWbemServices
Dim colLoggedEvents As SWbemObjectSet
Dim objEvent As SWbemObject
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' " & _
"AND EventCode = '" & eventCode & "'")
Dim i As Integer
Dim tmpDateValues() As Date
Dim n As Integer
n = colLoggedEvents.Count
ReDim tmpDateValues(0 To eventIndex - 1)
If n = 0 Then
ReDim tmpDateValues(n)
getAnyEventDateTime = tmpDateValues
Exit Function
End If
If n < eventIndex Then eventIndex = n
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1
Set objEvent = colLoggedEvents.ItemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
tmpDateValues(i) = retTimeWritten
DoEvents
Next
errorHandler:
getAnyEventDateTime = tmpDateValues
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
リスト2-2
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date
parseTimeWritten = _
CDate(Mid(receiveData, 1, 4) & "/" & _
Mid(receiveData, 5, 2) & "/" & _
Mid(receiveData, 7, 2) & _
" " & _
Mid(receiveData, 9, 2) & ":" & _
Mid(receiveData, 11, 2) & ":" & _
Mid(receiveData, 13, 2))
End Function
リスト2-3
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
