「直近○回分のシャットダウン日時」の配列を返すFunction
直近のイベント発生日時を配列化するFunction
このとき
作成したFunctionは、
直近のイベント日時を取得するFunction
だったが、これをちょいと改造して、
直近○回分のイベント日時を取得して配列化するFunction
にする。
改造するポイント
前回のリスト２を再掲する。
前回のリスト２
Public Function getLastEventDateTime( _
ByVal eventCode As WindowsEventCode) As Date '……(1.)'
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
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 & "'")
If Not colLoggedEvents.itemIndex(0) Is Nothing Then '……(2.)'
Set objEvent = colLoggedEvents.itemIndex(0)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
getLastEventDateTime = retTimeWritten
End If
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
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
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
改造ポイントは２つ。すなわち、
- 「○回分」を表す引数を追加する
- 必要な数だけループしてイベント日時を取得し、配列にぶち込む
である。
改造したコード
まずは改造後のコードを載せる。
リスト１ 標準モジュール
'///宣言セクション' Public Enum WindowsEventCode osStartUp = 12 osShutDown = 13 winStartUp = 6005 winShutDown = 6006 End Enum '///直近○回分のイベント日時を配列化する' Public Function getAnyEventDateTime( _ ByVal eventIndex As Integer, _ ByVal eventCode As WindowsEventCode) _ As Date() '……(1)' 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 '……(2)' ReDim tmpDateValues(0 To eventIndex - 1) For i = 0 To eventIndex - 1 If Not colLoggedEvents.itemIndex(i) Is Nothing Then '……(3)' Set objEvent = colLoggedEvents.itemIndex(i) '……(4)' retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.TimeWritten)) tmpDateValues(i) = retTimeWritten '……(5)' End If DoEvents Next getAnyEventDateTime = tmpDateValues '……(6)' errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///日付時刻文字列変換用' 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 '///UTC→JST変換用' Private Function convUTCtoJST(ByVal timeData As Date) As Date convUTCtoJST = DateAdd("h", 9, timeData) End Function
変更箇所についてのみ説明する。
まずは、(1)の
Public Function getAnyEventDateTime( _
ByVal eventIndex As Integer, _
ByVal eventCode As WindowsEventCode) _
As Date()
引数が２つになった。
第１引数のeventIndexで配列に格納する要素数を受け取る。eventIndexという名前にしてしまったが、実際に受け取る数字は要素数なので、インデックス番号最大値＋１。ちょっと分かりにくいかもなあ。
第２引数は前回のまま。WindowsEventCodeという自作列挙体型にしている。列挙体については、現行
Public Enum WindowsEventCode osStartUp = 12 osShutDown = 13 winStartUp = 6005 winShutDown = 6006 End Enum
の４つだけだが、今後随時必要なものを追加していったら良いと思う。
(2)からの２行
Dim tmpDateValues() As Date ReDim tmpDateValues(0 To eventIndex - 1)
では、取得したイベント日時をぶち込むための配列変数tmpDateValueを準備し、すかさず「eventIndex - 1」でReDim。
一旦配列を作成しておいて、最後にこの配列を返り値にする、というおなじみの段取り。
(3)の
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
では、一応取得したコレクションの要素一つ一つについて確認するようにした。別に一つ一つ確認する必要はないようにも思うが……。
(4)の
Set objEvent = colLoggedEvents.itemIndex(i)
で、コレクションの要素を変数objEventにぶち込み、日時をVBAの日付型の形に変換し、JSTに変換したら、(5)の
tmpDateValues(i) = retTimeWritten
で、一旦配列変数tmpDateValuesに格納していく。
このForループを抜けたら、配列は完成しているので、最後に(6)の
getAnyEventDateTime = tmpDateValues
で配列を返り値にしたらおしまい。
使用例
次のような準備をして使ってみる。
こんなふうに、
シートを準備して、セル範囲に「WriteInArea」と名前を付ける。
で、下記のコードで実行してみる。
リスト２ 標準モジュール
'///エントリポイント'
Public Sub run()
Call eraseData
Call writeEventDateTime(30, winShutDown)
End Sub
'///データを取得して書き込む'
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode) '……(1)'
If cnt > 30 Then cnt = 30 '……(2)'
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim baseCell As Range
Dim dateValues As Variant '……(3)'
dateValues = getAnyEventDateTime(cnt, ec)
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To cnt '……(4)'
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
'///書き込みエリアをクリアする'
Public Sub eraseData()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Sh.Range("WriteInArea").Value = ""
End Sub
writeEventDateTimeプロシージャが、データ書き込みのメインの処理。
(1)の
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
で、２つの引数を設定。
cntは、「○回分のイベント」の「○」の部分。ecは「イベント」の部分。
直近cnt回分のecイベントの日時をセルに書き込んでいくマクロ、ということになる。
(2)の
If cnt > 30 Then cnt = 30
では、第１引数に30を超える数値が渡されたときにcntを「30」にするようにしている。単独のイベントログは30個までっぽいので（真相は知りませんｗ）。
(3)からの２行
Dim dateValues As Variant dateValues = getAnyEventDateTime(cnt, ec)
では、getAnyEventDateTimeの返り値を受け取るためのVariant型変数を準備して、返り値を受け取っている。
あとは、(4)からの３行
For i = 1 To cnt baseCell.Offset(i, 0).Value = dateValues(i - 1) Next
のForループで、一つづつ下へ下へと配列dateValuesの要素を書き込んで行く。
実行結果
エントリポイントのrunプロシージャを実行すると、
この通り、日時が書き込まれた。
おわりに
もし、
職場のPCをシャットダウンする時刻＝職場から出る時刻
みたいな人だったら、
本当の退社時刻
を記録するのに使えるかも。
職場のPCでこのプログラムを実行すると、「へえ、この日はこんなに遅くまで残ってたのか……」とか、「この時期は結構順調だったんだな……」ということが分かって面白かったっす。
追記
あ、今回のリスト１の中で、getAnyEventDateTimeプロシージャの冒頭、変数宣言のところで、しれーっと
Dim strComputer As String Dim objWMIService As SWbemServices Dim colLoggedEvents As SWbemObjectSet Dim objEvent As SWbemObject Dim retTimeWritten As Date
なんて書いちゃってますね。
SWbemServices型とか、SWbemObjectSet型とか、SWbemObject型とか。
これは、
このとき、 id:imihito さんからいただいたコメント、すなわち
ItemIndex の出所は「Microsoft WMI Scripting V 1.2 Library」を参照して、オブジェクトブラウザから「WbemScripting.SWbemObjectSet」を見て貰えれば
に従って、オブジェクトブラウザで調べてみて発見しました。
こいつらがSWbemServicesクラスのメンバ。確かにExecQueryメソッドってのがある。
SWbemObjectSetクラスのメンバ。ItemIndexプロパティがある。
んで、コチラがSWbemObjectクラスのメンバ……って、TimeWrittenプロパティなんてねえぞ！？
でも、フツーに取得できているということは、親クラスから継承しているんでしょうね。たぶん。
ちなみに、（当たり前ですが）参照設定で「Microsoft WMI Scripting Vx.x Library」をオンにしておかないと派手にエラーが出ます。
