直近○回分のイベント発生日時を配列化するFunctionの修正

直近のイベント発生日時を配列化するFunctionの修正

このとき

akashi-keirin.hatenablog.com

作成したFunctionについて、対応できるイベントを増やそうとして、いろいろ不具合に気づいたので修正する。

コードへのリンクはコチラ

1.無意味な判定をやめる

イベントのデータが取得できているかどうかを、

If Not colLoggedEvents.itemIndex(i) Is Nothing Then

で判定しようとしていたが、そもそも該当するイベントがなかったときは、

f:id:akashi_keirin:20171112065236j:plain

f:id:akashi_keirin:20171111170535j:plain

colLoggedEvents.itemIndex(i)

ここを評価した時点でエラーが出る。

要するに、この判定はまるで無意味だったということになる。

2.イベントのデータが指定した数よりも少なかった場合の対応

たとえば、直近10回分のデータを取得しようとしたのに、データが2個しかなかった、という場合に、

colLoggedEvents.ItemIndex(i)

のところで、

f:id:akashi_keirin:20171111170609j:plain

「インデックスが有効範囲にありません。」てやつ。コレクションの要素数を超えているんだから当然だ。

コードの修正

上記1.、2.を踏まえて修正する。

修正前

まず、

  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.への対応

まず、(1)からの2行

Dim n As Integer
n = colLoggedEvents.Count

で、変数 n にcolLoggedEventsのCountプロパティの値をぶち込む。

んで、(2)からの5行

If n = 0 Then
  ReDim tmpDateValues(n)
  getAnyEventDateTime = tmpDateValues
  Exit Function
End If

で、n が0のとき、すなわち、該当するイベントがなかった場合の対応をする。

素数1の配列を返り値にしている。特に何も書き込まなくても、1900年1月0日(1899年12月30日)の0時0分0秒がセットされているみたい。

これで、(1)の問題はクリア。

2.への対応

まず、(3)からの2行

If n < eventIndex Then eventIndex = n
ReDim tmpDateValues(0 To eventIndex - 1)

で、取得したデータの数が要求した数よりも少ない場合に対応。

「10回分のデータを寄こせ!」と呼び出しても、n すなわちcolLoggedEventsのCountプロパティの値が、たとえば「2」だったら、eventIndexの値を「2」に書き換えてしまうことでエラーの芽を摘む。

そして、即座にReDim。まあ、ここまでムキになってReDimすることもないのでしょうが。

ここまで来たら、(4)からの6行

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

変えたのは3箇所。

(1)の

Call writeEventDateTime(10, 6008)

では、対象のイベントIDとして6008を指定。

正常にシャットダウンせずに終了、ということらしい。

(2)からの2行(正味1行)

If dateValues(0) = CDate(0) Then _
    MsgBox "該当するデータがありません。": Exit Sub

は、該当するイベントデータがなかった場合の対応。

イベントデータが存在しなかった場合、受け取った配列の1番目の要素(インデックス番号「0」の要素)は、日付の初期値のはずなので、この場合はメッセージを表示して終了する。

後は(3)からの3行

For i = 1 To UBound(dateValues) + 1
  baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next

をこう変えた。Function内部で配列の要素数を変えることがあるので、Uboundで要素数をこの段階で調べる必要がある。

実行結果

f:id:akashi_keirin:20171111170653j:plain

10回分要求したが、データは2つしかなかったみたいだ。

ちなみに、第2引数を「7005」にして、

Call writeEventDateTime(10, 6008)

呼び出してみると、

f:id:akashi_keirin:20171111170704j:plain

ちゃんとメッセージが表示された。

おわりに

取り扱っているオブジェクトがイメージしにくいものばかりなので、どんなエラーが起こるのか予想しづらいなあ。

今回使用したコード

いちおう、全部載っけときます。

リスト1-1
Public Sub run()
  Call eraseData
  Call writeEventDateTime(10, 6008)
'///↑第1引数と第2引数を変えれば、いろんなデータを取得して書き込むことができます。'
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

@akashi_keirin on Twitter

「直近○回分のシャットダウン日時」の配列を返すFunction

直近のイベント発生日時を配列化するFunction

このとき

akashi-keirin.hatenablog.com

作成したFunctionは、

直近のイベント日時を取得するFunction

だったが、これをちょいと改造して、

直近○回分のイベント日時を取得して配列化するFunction

にする。

改造するポイント

前回のリスト2を再掲する。

前回のリスト2
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

改造ポイントは2つ。すなわち、

  1. 「○回分」を表す引数を追加する
  2. 必要な数だけループしてイベント日時を取得し、配列にぶち込む

である。

改造したコード

まずは改造後のコードを載せる。

リスト1 標準モジュール
'///宣言セクション'
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
'///UTCJST変換用'
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()

引数が2つになった。

第1引数のeventIndexで配列に格納する要素数を受け取る。eventIndexという名前にしてしまったが、実際に受け取る数字は要素数なので、インデックス番号最大値+1。ちょっと分かりにくいかもなあ。

第2引数は前回のまま。WindowsEventCodeという自作列挙体型にしている。列挙体については、現行

Public Enum WindowsEventCode
  osStartUp = 12
  osShutDown = 13
  winStartUp = 6005
  winShutDown = 6006
End Enum

の4つだけだが、今後随時必要なものを追加していったら良いと思う。

(2)からの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

で配列を返り値にしたらおしまい。

使用例

次のような準備をして使ってみる。

こんなふうに、

f:id:akashi_keirin:20171111094142j:plain

シートを準備して、セル範囲に「WriteInArea」と名前を付ける。

で、下記のコードで実行してみる。

スト2 標準モジュール
'///エントリポイント'
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)

で、2つの引数を設定。

cntは、「○回分のイベント」の「○」の部分。ecは「イベント」の部分。

直近cnt回分のecイベントの日時をセルに書き込んでいくマクロ、ということになる。

(2)の

If cnt > 30 Then cnt = 30

では、第1引数に30を超える数値が渡されたときにcntを「30」にするようにしている。単独のイベントログは30個までっぽいので(真相は知りませんw)。

(3)からの2行

Dim dateValues As Variant
dateValues = getAnyEventDateTime(cnt, ec)

では、getAnyEventDateTimeの返り値を受け取るためのVariant型変数を準備して、返り値を受け取っている。

あとは、(4)からの3行

For i = 1 To cnt
  baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next

のForループで、一つづつ下へ下へと配列dateValuesの要素を書き込んで行く。

実行結果

エントリポイントのrunプロシージャを実行すると、

f:id:akashi_keirin:20171111094152j:plain

この通り、日時が書き込まれた。

おわりに

もし、

職場のPCをシャットダウンする時刻=職場から出る時刻

みたいな人だったら、

本当の退社時刻

を記録するのに使えるかも。

職場のPCでこのプログラムを実行すると、「へえ、この日はこんなに遅くまで残ってたのか……」とか、「この時期は結構順調だったんだな……」ということが分かって面白かったっす。

@akashi_keirin on Twitter

追記

あ、今回のリスト1の中で、getAnyEventDateTimeプロシージャの冒頭、変数宣言のところで、しれーっと

Dim strComputer As String
Dim objWMIService As SWbemServices
Dim colLoggedEvents As SWbemObjectSet
Dim objEvent As SWbemObject
Dim retTimeWritten As Date

なんて書いちゃってますね。

SWbemServices型とか、SWbemObjectSet型とか、SWbemObject型とか。

これは、

akashi-keirin.hatenablog.com

このとき、 id:imihito さんからいただいたコメント、すなわち

ItemIndex の出所は「Microsoft WMI Scripting V 1.2 Library」を参照して、オブジェクトブラウザから「WbemScripting.SWbemObjectSet」を見て貰えれば

に従って、オブジェクトブラウザで調べてみて発見しました。

f:id:akashi_keirin:20171111100802j:plain

こいつらがSWbemServicesクラスのメンバ。確かにExecQueryメソッドってのがある。

f:id:akashi_keirin:20171111100814j:plain

SWbemObjectSetクラスのメンバ。ItemIndexプロパティがある。

f:id:akashi_keirin:20171111100825j:plain

んで、コチラがSWbemObjectクラスのメンバ……って、TimeWrittenプロパティなんてねえぞ!?

でも、フツーに取得できているということは、親クラスから継承しているんでしょうね。たぶん。

ちなみに、(当たり前ですが)参照設定で「Microsoft WMI Scripting Vx.x Library」をオンにしておかないと派手にエラーが出ます。

Join関数について

Join関数というものがある

Join関数

前回の記事

akashi-keirin.hatenablog.com

に、 id:imihito さんからコメントをいただいた。曰く、

argsByArray 相当処理として、組み込み関数にJoin 関数というものが有ったりします
```vba
Join(strArray, "! ")
```

ははは。そういえばそんなのあったなー。またしても、

車輪の再発明

ですよ。はははorz

で、やってみた。

Join関数を使ってみる

とりあえず、次のようなコードでやってみる。

リスト1 標準モジュール
Public Sub test()
  Dim a As Variant
  a = Array("アホ", "ボケ", "カス", "デコスケ")    '……(1)'
  Debug.Print Join(a, "! ")    '……(2)'
End Sub

まず、(1)の

a = Array("アホ", "ボケ", "カス", "デコスケ")

で、Variant型変数の a にArray関数を使って配列をぶち込んでおく。

んで、(2)の

Debug.Print Join(a, "! ")

でJoin関数の返り値をイミディエイト・ウインドウに表示してみる。

実行結果

f:id:akashi_keirin:20171111083613j:plain

この通り、配列の各要素のカンチャンに第2引数の「! 」を入れてつなげた文字列が出力された。

まるっきりSplit関数の反対なのね。

リスト1改 標準モジュール

ちょっとだけ付け加える。

Public Sub test()
  Dim a As Variant
  a = Array("アホ", "ボケ", "カス", "デコスケ")
  Debug.Print Join(a, "! ") & "!"    '……(*)'
End Sub

(*)の

Debug.Print Join(a, "! ") & "!"

は、Join関数の返り値に「!」を付け加えている。

実行結果

f:id:akashi_keirin:20171111083621j:plain

要するに、

Dim i As Integer
Dim tmp As String
For i = 0 To UBound(a)
  If i = 0 Then
    tmp = a(i)
  Else
    tmp = tmp & "! " & a(i)
  End If
Next
tmp = tmp & "!"
Debug.Print tmp

と同じ処理が、わづか3行でできてしまうということだ。

一応、実験。

次のコードで検証する。

スト2 標準モジュール
Public Sub test()
  Dim a As Variant
  a = Array("アホ", "ボケ", "カス", "デコスケ")
  Debug.Print Join(a, "! ") & "!"
  Dim i As Integer
  Dim tmp As String
  For i = 0 To UBound(a)
    If i = 0 Then
      tmp = a(i)
    Else
      tmp = tmp & "! " & a(i)
    End If
  Next
  tmp = tmp & "!"
  Debug.Print tmp
End Sub
実行結果

f:id:akashi_keirin:20171111083633j:plain

ハイ、全く同じ実行結果でした。

おわりに

またしても、体系的に学んでいない弱みを露呈してしまった。

@akashi_keirin on Twitter

配列を引数にすることはできるのか

配列を引数にすることはできるのか

配列を引数にしてみる

プロシージャの引数に配列を指定することはできるのだろうか、と思ってやってみた。

とりあえず、

Public Function argsByArray(ByVal ar() As String) As String

としてみたら、

f:id:akashi_keirin:20171110203501j:plain

こんなふうにいきなりコンパイル・エラーw

配列を引数にするにはByRefにしないといけないらしい。ということはできるんだね。

とりあえず、次のようなFunctionを作ってみた。

リスト1 標準モジュール
Public Function argsByArray(ByRef ar() As String) As String
  Dim n As Integer
  n = UBound(ar)    '……(1)'
  Dim i As Integer
  Dim tmp As String
  For i = 0 To n    '……(2)'
    tmp = tmp & ar(i) & "! "
  Next
  argsByArray = Left(tmp, Len(tmp) - 1)    '……(3)'
End Function

簡単なコードなので、説明するまでもないかも知れないけれど、一応。

(1)の

n = UBound(ar)

で、引数として受け取ったString型の配列 ar() のインデックス番号最大値を変数 n にぶち込む。

(2)からの3行

For i = 0 To n
  tmp = tmp & ar(i) & "! "
Next

で、配列 ar() の各要素を、後ろに「! 」(全角感嘆符と全角スペース)を付けて連結し、変数 tmp にぶち込んで行く。

あとは、(3)の

argsByArray = Left(tmp, Len(tmp) - 1)

でLeft関数によって右端の全角スペースを削ってできた文字列を返り値にしておしまい。

実行

次のコードで実行してみる。

スト2 標準モジュール
Public Sub testArgsByArray()
  Dim strArray() As String
  Dim tmpArray As Variant
  tmpArray = Array("アホ", "ボケ", "カス")    '……1.'
  Dim i As Integer
  Dim n As Integer
  n = UBound(tmpArray)    '……2.'
  ReDim strArray(0 To n)    '……3.'
  For i = 0 To n    '……4'
    strArray(i) = tmpArray(i)
  Next
  MsgBox argsByArray(strArray())    '……(*)'
End Sub

文字列型の配列を作るのにArray関数が使いたかったので、メッチャ面倒くさいやり方をしている。すなわち、

  1. Array関数の返り値を一旦Variant型の変数tmpArrayにぶち込む
  2. できあがった配列tmpArrayのインデックス番号最大値をUBound関数で調べて変数 n にぶち込む。
  3. 文字列型配列変数strArray()を n でReDimする。
  4. Forループを使ってtmpArrayの内容をstrArray()に移す

すんません。配列初心者なので、こんな方法しか思いつきませなんだ(←この言い方、横山光輝三国志』でよく出てくるよね?)。

なんていうか、

strArray(0) = "アホ"
strArray(1) = "ボケ"
strArray(2) = "カス"

みたいなやり方がイヤだっただけなんですけど。

あとは、(*)の

MsgBox argsByArray(strArray())

で、リスト1のargsByArray関数の返り値をメッセージボックスで表示する。

実行結果

f:id:akashi_keirin:20171110203510j:plain

うん。うまく行った。

クエリの「WHERE」の部分の文字列を作るのに使えないかなあ、と思っただけです。ほれ、「OR」とか「AND」でつなぐ条件の数が変化しても、引数が配列だったら対応できるじゃないですか。

@akashi_keirin on Twitter

直近の起動・終了日時を取得するFunction(2)

直近のイベント日時を取得するFunctionの改良

前回

akashi-keirin.hatenablog.com

の続きです。

イベントコードを引数として受け取る

前回は、シャットダウン日時を取得するFunction、起動日時を取得するFunctionの2種類を作ったわけだが、記事中でも言及していたとおり、2つの違いはイベントコードだけなので、イベントコードを引数にして一本化すれば良いのであった。

ついでに、引数のイベントコードは限られたものなので、このときに教えてもらった

引数に列挙体型を指定する裏技

を使うことにした。

リスト1 標準モジュールの宣言セクション
Public Enum WindowsEventCode
  winStartUp = 6005
  winShutDown = 6006
End Enum

こうしておくことで、Functionの引数に自作の列挙体型を指定することができる。これは便利だ。

スト2 標準モジュール
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 & "'")    '……(2)'
  If Not colLoggedEvents.itemIndex(0) Is Nothing Then    '……(3)'
    Set objEvent = colLoggedEvents.itemIndex(0)    '……(4)'
    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

まず(1)の

Public Function getLastEventDateTime( _
                  ByVal eventCode As WindowsEventCode) As Date

WindowsEventCode型の引数を指定している。もちろん、「WindowsEventCode型」というのは自作の列挙体型。

こいつを指定しておくことで、

f:id:akashi_keirin:20171105204421j:plain

こんなふうにヒントが出るし、

f:id:akashi_keirin:20171105204429j:plain

インテリセンスで入力候補も表示される。メッチャ便利。

f:id:akashi_keirin:20171105204439j:plain

ま、イベントコードに該当する数字を渡したら、そのイベントの直近の日時を返してしまうんですがw(イベントコード13って何だったっけ?)

んで、(2)の

Set colLoggedEvents = _
  objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
                          "WHERE Logfile = 'System' " & _
                          "AND EventCode = '" & eventCode & "'")

ExecQueryメソッドの引数のクエリの「AND」以下の部分、

AND EventCode = '6005'

と、イベントコードを直接指定していたのを

AND EventCode = '" & eventCode & "'

と改めただけ。シングルクオートの中身を変数にしただけですな。

こうすることで、1つのプロシージャにまとめることができた。

イベントログコレクションのItemIndexプロパティを使う

さて、今度は、ムダにFor Each ~ Nextを使っていた箇所の改善。

前回

たとえば、
Set objEvent = colLoggedEvents.Item(1)
とかで行けると思ったが、こうするとエラーになった。

などと書いていたのだが、例によって id:imihito さんからの非常にありがたいご指摘が。まさに神の声。

Set objEvent = colLoggedEvents.Item(1)

Set objEvent = colLoggedEvents.ItemIndex(0)
とすると上手くいくと思います。

とのこと。

おおっ! 知らなかった! ……って、VBAに元からあるコレクションでも何でもないんだから、メンバの表記が違うのが当たり前ですよね。VBAの記法って、ちょっと独特ですから。

また、

ItemIndex の出所は「Microsoft WMI Scripting V 1.2 Library」を参照して、オブジェクトブラウザから「WbemScripting.SWbemObjectSet」を見て貰えれば

ということなので、VBEの「ツール」から「参照設定」を開くと、

f:id:akashi_keirin:20171105204412j:plain

ホントだ! ちゃんとオブジェクトライブラリがあったんだ。

……てことは、変数もObject型にしなくて済むってことか。ほう……。

ともあれ、Itemプロパティではなく、ItemIndexプロパティ、しかも「0」始まり、ということを知ったので、早速(3)のように

If Not colLoggedEvents.itemIndex(0) Is Nothing Then

と書いた。これで、コレクションの1つ目の要素が存在するかどうかで判定ができる。

んで、(4)の

Set objEvent = colLoggedEvents.itemIndex(0)

で変数objEventにコレクションの1つ目をぶち込んで、後は前回と同じ。

もちろん、

With colLoggedEvents

でまとめておいて、

With colLoggedEvents
  If Not .itemIndex(0) Is Nothing Then
    retTimeWritten = convUTCtoJST(parseTimeWritten(.itemIndex(0).timeWritten))
    getLastEventDateTime = retTimeWritten
  End If
End With

と書くことも出来たとは思うけれど、慣れ親しんだobjEventさんを抹殺するのも忍びないし、可読性という点でイマイチなので、objEventさんには続投願うことにした。

おわりに

まだまだ知らないことが多いけれど、プログラミングが本当に楽しくなってきたぞ。

id:imihito さん、毎度毎度、本当にありがとうございます!!!!!!!!

直近の起動・終了日時を取得するFunction

Windowsの起動・終了時刻を返すFunction

※改良版はコチラ

直近の起動・終了時刻を返す

前回の

akashi-keirin.hatenablog.com

リスト1に手を加えて、

  1. 直近のシャットダウン日時
  2. 今回の起動日時

を取得するFunctionを作ってみる。

今回作成したコード

とりあえず全体を載っけておく。

リスト1 標準モジュール
'///リスト1-1'
'///直近のWindows起動時刻を返す'
Public Function getLastStartUpDateTime() As Date
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 = '6005'")
  If Not colLoggedEvents Is Nothing Then
    For Each objEvent In colLoggedEvents
      retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
      getLastStartUpDateTime = retTimeWritten
      Exit For
    Next
  End If
errorHandler:
  Set objWMIService = Nothing
  Set colLoggedEvents = Nothing
  Set objEvent = Nothing
End Function

'///リスト1-2'
'///直近のWindowsシャットダウン時刻を返す'
Public Function getLastShutDownDateTime() As Date
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 = '6006'")
  If Not colLoggedEvents Is Nothing Then
    For Each objEvent In colLoggedEvents
      retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
      getLastShutDownDateTime = retTimeWritten
      Exit For
    Next
  End If
errorHandler:
  Set objWMIService = Nothing
  Set colLoggedEvents = Nothing
  Set objEvent = Nothing
End Function

'///リスト1-3'
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

'///リスト1-4'
Private Function convUTCtoJST(ByVal timeData As Date) As Date
  convUTCtoJST = DateAdd("h", 9, timeData)
End Function

リスト1-1、1-2がメインの処理をするFunction、リスト1-3、1-4は日付時刻データの整形及び変換に使うFunction。

リスト1-3と1-4については、引数の名前を変えて、インデントを整えただけ。前回から基本的には何も変わっていない。

リスト1-1 直近のWindows起動時刻を返す
Public Function getLastStartUpDateTime() As Date
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")    '……(1)'
  Set colLoggedEvents = _
    objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
                            "WHERE Logfile = 'System' AND EventCode = '6005'")    '……(2)'
  If Not colLoggedEvents Is Nothing Then    '……(3)'
    For Each objEvent In colLoggedEvents    '……(4)'
      retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten))
      getLastStartUpDateTime = retTimeWritten
      Exit For    '……(5)'
    Next
  End If
errorHandler:    '……(6)'
  Set objWMIService = Nothing
  Set colLoggedEvents = Nothing
  Set objEvent = Nothing
End Function

(1)の

Set objWMIService = GetObject("winmgmts:" & _
                              "{impersonationLevel=impersonate}!\\" & _
                              strComputer & _
                              "\root\cimv2")

は、WMIサービスのインスタンスをobjWMIServiceというオブジェクト変数にぶち込んでいるだけ。GetObject関数の引数を少しでも読みやすくするために改行を入れてみた。

(2)も

Set colLoggedEvents = _
  objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
                          "WHERE Logfile = 'System' AND EventCode = '6005'")

前回のコードと同じだが、クエリの部分を大文字にしてそれっぽくしてみたw

大きく変えたのはここから。

元のコードでは、ここの条件判定を

If colLoggedEvents.Count > 0 Then

こうしていた。最初はこのままにしていたんだが、全体の処理に異様に時間がかかる。

で、ステップ実行で見ているとここの処理で異様に時間がかかっていた。

Countプロパティの値を参照するためには、イベントログコレクションを全て取得しなくてはならず、そのために時間がかかっているのだと考えた。そこで、上掲(3)の通り、

If Not colLoggedEvents Is Nothing Then

とした。

とにかくcolLoggedEventsコレクションに何かセットされていたらよし、としたわけ。

Object型変数の初期値は「Nothing」だとどこかで見たことがあるので(←裏取れよ)、とりあえずこうした。今のところ、爆速になっている。

で、(4)では

For Each objEvent In colLoggedEvents

の形でcolLoggedEventsコレクションの要素をFor Eachで回すことにしている。

前回の実行結果でもお分かりの通り、イベントログは現在→過去の順に取得しているっぽいので、たとえば、

Set objEvent = colLoggedEvents.Item(1)

とかで行けると思ったが、こうするとエラーになった。

だもんで、ブサイクなのは承知の上で、For Eachのループの中に条件判定も何もなしで(5)のように

Exit For

と書くというマヌケなことに……。

ここは少し改良の余地があるな。

(6)の

errorHandler:
  Set objWMIService = Nothing
  Set colLoggedEvents = Nothing
  Set objEvent = Nothing

は、おなじみのエラーキャッチブロックなんだが、普通だとラベルの直前に書くべき

Exit Function

を書いていない。

Object型という得体の知れない型の変数を用いているので、オブジェクト変数の解放はやるべきだと思ったが、どの道解放するなら処理を2回書かなくても済むと思ったので……。これで問題あるようなら誰か教えてくだされ。

リスト1-2 直近のWindowsシャットダウン時刻を返す
Public Function getLastShutDownDateTime() As Date
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 = '6006'")
  If Not colLoggedEvents Is Nothing Then
    For Each objEvent In colLoggedEvents
      retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten))
      getLastShutDownDateTime = retTimeWritten
      Exit For
    Next
  End If
errorHandler:
  Set objWMIService = Nothing
  Set colLoggedEvents = Nothing
  Set objEvent = Nothing
End Function

中身はほとんど同じなので、説明は省略。っていうか、違いはイベントコードの「6005」と「6006」だけなんだから、イベントコードを引数にして一つのFunctionにまとめりゃいいじゃねーか、ということですよね。ははは。

ついでに、日付時刻文字列を整形・変換するコードも分けて載せておく。

リスト1-3 日付時刻文字列を標準の日付時刻形式に変換する
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
リスト1-4 USCをJSTに変換する
Private Function convUTCtoJST(ByVal timeData As Date) As Date
  convUTCtoJST = DateAdd("h", 9, timeData)
End Function

実行結果

次のコードで実行する。

スト2 標準モジュール
Public Sub testGetWindowsLog()
  MsgBox "前回シャットダウン日時" & vbCrLf & getLastShutDownDateTime
  MsgBox "今回起動日時" & vbCrLf & getLastStartUpDateTime
End Sub

f:id:akashi_keirin:20171105085124j:plain

f:id:akashi_keirin:20171105085132j:plain

あれれ??? なんかおかしいぞ……。

どうやら、Windows10では、「シャットダウンしたつもりだけれど実はシャットダウンしていない」ということがあるらしい……orz

おわりに

ともあれ、イベントコードを渡せば、直近の当該イベントについてWindowsのログを引っ張ってくることができるようなので、いろいろと応用ができそうですなあ。

@akashi_keirin on Twitter

コチラもどうぞ

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

Windowsのシャットダウン日時を取得する

Windowsのシャットダウン時刻を取得する

Windwosのイベントログを取得するには?

Excel VBA質問箱 IV【74506】Re:VBAシャットダウン時刻取得にて、次のコードを発見した。

リスト1 標準モジュール
Public Sub test()    '……(1)'
  Call EnumShutdownDateTime(Range("A1"))
End Sub

Public Sub EnumShutdownDateTime(ByVal r As Range)
  Dim strComputer As String    '……(2)'
 Dim objWMIService As Object
 Dim colLoggedEvents As Object
 Dim objEvent As Object
 Dim offsetRow As Long
 Dim tTimeWritten As Date
  
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")    '……(3)'
 Set colLoggedEvents = objWMIService.ExecQuery _
   ("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
   & "EventCode = '6006'")    '……(4)'
  
 If colLoggedEvents.Count > 0 Then    '……(5)'
  offsetRow = 0
  Application.ScreenUpdating = False
  For Each objEvent In colLoggedEvents    '……(6)'
   tTimeWritten = _
    ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))
   r.Offset(offsetRow, 0).Value = tTimeWritten
   offsetRow = offsetRow + 1
  Next objEvent
  Application.ScreenUpdating = True
 End If
  
 Set colLoggedEvents = Nothing
 Set objWMIService = Nothing
End Sub

Private Function ParseTimeWritten(ByVal v As Variant) As Date    '……(7)'
 ParseTimeWritten = _
  CDate(Mid(v, 1, 4) & "/" & Mid(v, 5, 2) & "/" & Mid(v, 7, 2) & _
  " " & Mid(v, 9, 2) & ":" & Mid(v, 11, 2) & ":" & Mid(v, 13, 2))
End Function

Private Function ConvUTCtoJSC(ByVal d As Date) As Date    '……(8)'
 ConvUTCtoJSC = DateAdd("h", 9, d)
End Function

まず、(1)の

Public Sub test()
	Call EnumShutdownDateTime(Range("A1"))
End Sub

は、エントリポイント。引数にA1セルを指定して、EnumShutdownDateTimeを呼んでいるだけ。処理の中身はEnumShutdownDateTimeに書いてある。

んで、そのEnumShutdownDateTimeプロシージャ。

まず、冒頭(2)からの6行

Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim offsetRow As Long
Dim tTimeWritten As Date

変数の宣言。

  • strComputer:
    コンピュータ名を格納する。
  • objWMIService:
    WMIサービスオブジェクトを格納する。
  • colLoggedEvents:
    Windowsのイベントログから拾い出したイベントのコレクションを格納する。
  • objEvent:
    colLoggedEventsコレクションの要素を格納する。
  • tTimeWritten:
    イベントから取得した日時を格納する。

だいたいこんな用途。

(3)の

Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

では、GetObject関数を用いて、WMIサービスオブジェクトを捕まえているっぽい。

「WMI」というのは、コチラによると、

Windows Management Instrumentation

のことらしい。

(ほとんどすべての) Windows リソースへのアクセス、構成、管理、および監視を可能にする管理基盤

だということなので、こいつをゴニョゴニョすれば、Windowsそのもののあれやこれやを取得できるのでしょう(←雑過ぎる理解)。

GetObjectの引数が長ったらしいけど、1行で書くと、

"winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2"

となり、strComputerの値が「.」(このコンピュータ)なので、要するに

"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"

ということになるのだろう。

で、

winmgmts:

ってのは、コチラ

GetObjectの第1パラメータとして指定している“winmgmts:”は、ファイル名ではなく、WMIを表す文字列である(Windows Managementsの略だと思われる)。これはURLの先頭で利用するプロトコルを指定する「http:」のようなキーワードだと考えればよい。通常のファイルではない特別な参照方法である。

とあるので、WMIにアクセスするための特別な指定の仕方のようだ。

んで、

{impersonationLevel=impersonate}

について調べてみると、

Constant value Description Google翻訳
Impersonate 3 Allows objects to use the credentials of the caller. This is the recommended impersonation level for Scripting API for WMI calls. オブジェクトが呼び出し元の資格情報を使用することができます。これはWMI呼び出しのためのスクリプティングAPI推奨偽装レベルです。

とのこと(コチラをどうぞ)。WMIにアクセスするにあたってのセキュリティレベルか何かを指定しているのだろう。

つまり、objWMIServiceに格納するWMIサービスオブジェクトを取得するのには、次の2点、すなわち、

  • ディレクトリの指定にはwinmgmts:という特殊な文字列を使う。
  • impersonationLevelを指定する

ことが必要だということ。

このあたり、WSHあたりを勉強した方がいいのかもな。

まだまだ続く。嫌になるなあ。

(4)の

Set colLoggedEvents = objWMIService.ExecQuery _
   ("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
   & "EventCode = '6006'")

今度は、(3)で取得したWMIサービスオブジェクトのExecQueryメソッドを用いて、colLoggedEventsにイベントの集合を格納している(のだと思う。自分でもよく分かっていないw)。

ExecQueryメソッドの引数は、1行で書くと

"Select * from Win32_NTLogEvent Where Logfile = 'System' and EventCode = '6006'"

ということなので、つまりはSQLのクエリを投げているってことですか???

「Win32_NTLogEvent」というテーブルから、「LogFile」フィールドの値が「'System'」かつ「EventCode」フィールドの値が「6006」のレコードを引っ張って来い、ということでしょうか。

SQLは全くの素人なので、間違えていたら親切に教えてくだされ。

とまれ、これでcolLoggedEventsにはイベントログの集合体が格納されていることになるのだろう。

「EventCode」の「6006」ってのは「シャットダウン」を指すので、colLoggedEventsにはシャットダウンイベントに関する記録が格納されていることになる(んだよね?)。

(5)の

If colLoggedEvents.Count > 0 Then

による条件判定は、colLoggedEventsコレクション(?)のCountプロパティを用いている。Countプロパティの値が0よりも大きいということは、何らかのイベントが取得できているということだからこうしているのだろう。

(6)からの6行(実質は5行)

For Each objEvent In colLoggedEvents
  tTimeWritten = _
    ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))
  r.Offset(offsetRow, 0).Value = tTimeWritten
  offsetRow = offsetRow + 1
Next objEvent

では、colLoggedEventsコレクションの中身について、まず、

tTimeWritten = ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))

でコレクションの要素(objEvent)のTimeWrittenプロパティから取得した日時(を表す文字列)を、(7)のParseTimeWritten関数を用いて標準の日付時刻形式に変換し、その上で(8)のConvUTCtoJSC関数で日本の時刻に変換している。

TimeWrittenプロパティから取得できる値が、例えば「2017年11月4日の15時37分00秒」だと20171104153700という何とも気の利かない形であること、及び

UTC協定世界時)」とは、世界各地の標準時を決めるときの基準となる「世界標準時」のことです。たとえば日本の標準時(JST)は「UTC」よりも 9時間進んでいるため「UTC+09:00」と表示されます。

ということ(コチラより)から、二重に変換せねばならん。ああめんどくさい。

まあ、そんなわけで、

tTimeWritten = ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))

を通過した後、変数tTimeWrittenには、めでたくシャットダウンイベントの起きた日時が格納されているのだ。

あとは、

r.Offset(offsetRow, 0).Value = tTimeWritten

で1回目ならoffsetRowが「0」なのでA1セルにtTimeWrittenに格納されている日時を書き込み、

offsetRow = offsetRow + 1

でoffsetRowをインクリメントして次のループへ。

よって、A1セルからスタートして、下へ下へシャットダウン日時を書き込んで行くことになる。

ついでに、(7)の

Private Function ParseTimeWritten(ByVal v As Variant) As Date
 ParseTimeWritten = _
  CDate(Mid(v, 1, 4) & "/" & Mid(v, 5, 2) & "/" & Mid(v, 7, 2) & _
  " " & Mid(v, 9, 2) & ":" & Mid(v, 11, 2) & ":" & Mid(v, 13, 2))
End Function

は、colLoggedEventsコレクションの要素のTimeWrittenプロパティから取得した日付時刻文字列をDate型の形に整形してDate型に変換するFunction。Mid関数を使った非常に原始的な処理だ。

あと、(8)の

Private Function ConvUTCtoJSC(ByVal d As Date) As Date
 ConvUTCtoJSC = DateAdd("h", 9, d)
End Function

は単純至極。TimeWrittenプロパティで取得した時刻を9時間進めることによって、UTCをJSCに変換している。

実行結果

エントリポイントであるtestプロシージャを実行すると、

f:id:akashi_keirin:20171104174622j:plain

こんなふうに、シャットダウン日時が上から下へと書き込まれた。

おわりに

WMIとか、初めて手を出したのだが、このあたりをしっかり勉強したらかなり面白いことができそうな気がしてきた。

今回は、人のコードを自分なりに説明しただけ、という形になってしまったが、ちょっとづつ分かってきたので、自分なりに手を加えていこうと思う。

@akashi_keirin on Twitter

追記

Function化しました。

akashi-keirin.hatenablog.com