Active Directory上からコンピュータオブジェクトを取得し、オンラインだった場合に起動時間を取得します。
オンラインかどうかの判定はPINGで行っているので、PING応答しないコンピュータはオフラインとみなされます。
動作させる場合には、以下の部分を利用しているドメイン名に変更してください。
DomainName = "dc=pnpk,dc=local"
クエリ内容をクライアントOSだけに絞りこめば、コンピュータを再起動しないで帰宅するアンチ省エネな社員を見つける事が出来るかもしれません。
'Active Directory上のコンピュータオブジェクトを参照し、コンピュータがオンラインだった場合に起動時間を取得します。 Option Explicit Const ADS_SCOPE_SUBTREE = 2 Dim DomainName '利用ドメインに合わせて以下の文字列を変更します。 DomainName = "dc=pnpk,dc=local" Call Main() Sub Main() Dim Query Query = "SELECT distinguishedName FROM 'LDAP://" & _ DomainName & "' WHERE objectCategory='computer'" Call QueryADSI(Query) End Sub 'SQLクエリでActive Directory内を検索します。 Function QueryADSI(SQL) On Error Resume Next Dim objConnection Dim objCommand Set objConnection =_ CreateObject("ADODB.Connection") Set objCommand =_ CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") =_ ADS_SCOPE_SUBTREE objCommand.CommandText = SQL Dim objRecordSet Dim strOBJ Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst Do Until objRecordSet.EOF strOBJ = ShowStatus(objRecordSet.Fields("distinguishedName").Value) 'ShowStatusの呼び出し If PingResult(strOBJ) Then 'Function BootUpTime呼び出し Wscript.Echo BootUpTime(strOBJ) Else Wscript.Echo strOBJ & "は起動していません。" End If objRecordSet.MoveNext Loop End Function 'DNからその他の情報を取得 Function ShowStatus(DN) Dim objDN Set objDN = GetObject("LDAP://" & DN ) ShowStatus = Mid(objDN.Name,4) Set objDN = Nothing End Function 'strComputerにpingを行って成功したらPingResultにTrueを返す Function PingResult(strComputer) Dim objWMIService Dim colItems Dim objItem Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery _ ("Select * from Win32_PingStatus " & _ "Where Address = '" & strComputer & "'") For Each objItem in colItems If objItem.StatusCode = 0 Then PingResult = True Else PingResult = False End If Next Set objWMIService = Nothing Set colItems = Nothing End Function 'コンピュータの起動時間を文字列で返します。 Function BootUpTime(strComputer) Dim objWMIService Dim colOperatingSystems Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") Dim objOS Dim dtmBootup Dim dtmLastBootupTime Dim dtmSystemUptime For Each objOS in colOperatingSystems dtmBootup = objOS.LastBootUpTime dtmLastBootupTime = WMIDateStringToDate(dtmBootup) dtmSystemUptime = DateDiff("s", dtmLastBootUpTime, Now) BootUpTime = strComputer & "の起動時間は" & Second2Time(dtmSystemUptime,1) & "です。" Next End Function 'UTC時間を時刻に変換 ※BootUpTimeとセットです。 Function WMIDateStringToDate(dtmBootup) WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _ Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _ & " " & Mid (dtmBootup, 9, 2) & ":" & _ Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup,13, 2)) End Function '秒を時分秒に変換 ※BootUpTimeとセットです。 Function Second2Time(intSec,int) Dim Day Dim Hour Dim Minute Dim Second Day = intSec \ 86400 Hour = (intSec - Day * 86400) \ 3600 Minute = (intSec - Day * 86400 - Hour * 3600) \ 60 Second = intSec - Day * 86400 - Hour * 3600 - Minute * 60 Select Case int Case 0 Second2Time = Day & ":" & LeadingZero(Hour) & ":" & LeadingZero(Minute) & ":" & LeadingZero(Second) Case 1 Second2Time = Day & "日" & LeadingZero(Hour) & "時間" & LeadingZero(Minute) & "分" & LeadingZero(Second) & "秒" Case Else Second2Time = "" End Select End Function '数値の整形 ※Second2Timeとセットです。 Function LeadingZero(intNumber) If intNumber < 10 Then LeadingZero = "0" & intNumber Else LeadingZero = intNumber End If End Function