Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7811 / 76734 ←次へ | 前へ→

【74506】Re:VBAシャットダウン時刻取得
回答  Blue  - 13/7/5(金) 17:15 -

引用なし
パスワード
   適当に・・・

testのほうを実行してください。

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

Public Sub EnumShutdownDateTime(ByVal r As Range)
  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 = "."
  Set objWMIService = GetObject("winmgmts:" _
  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colLoggedEvents = objWMIService.ExecQuery _
    ("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
      & "EventCode = '6006'")
  
  If colLoggedEvents.Count > 0 Then
    offsetRow = 0
    Application.ScreenUpdating = False
    For Each objEvent In colLoggedEvents
      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
  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
  ConvUTCtoJSC = DateAdd("h", 9, d)
End Function

5 hits

【74501】VBAシャットダウン時刻取得 よしだ 13/7/5(金) 9:42 質問
【74505】Re:VBAシャットダウン時刻取得 Blue 13/7/5(金) 16:39 発言
【74506】Re:VBAシャットダウン時刻取得 Blue 13/7/5(金) 17:15 回答
【74527】Re:VBAシャットダウン時刻取得 カリーニン 13/7/12(金) 21:23 発言

7811 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free