【VBA】pingを打って職場のほかのメンバーのPCシャットダウン状況を確認

うちの会社はPCのログを使って勤怠管理をしています。
で、月に何回か問題になるのがパソコンのシャットダウン漏れ。
保存し忘れたデータなどがあった場合、うまくシャットダウンができず正しく勤怠管理が行えません。。

pingを打って反応がなければシャットダウンされているんじゃね？と思い
やってみたところビンゴ！うまく調べることができたのでVBAでツールを作りました。
※ping乱れ打ちにはご注意ください

エクセルの画面はこんな感じ

VBAのスクリプト

Sub pingうつ()

Dim cmd As String
Dim wsh As Object
Dim i as long

'-n 1 -w 1のオプションをつけて1回のpingを打つ/タイムアウトをデフォルトの4秒から1秒に変更
    For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        cmd = "cmd.exe /c ping " & Cells(i, 2) & " -n 1 -w 1000"

'shell関数でコマンドを叩く
        Set wsh = CreateObject("WScript.Shell")
        If wsh.Run(cmd, vbNormalFocus, True) Then
            Cells(i, 3).Value = "シャットダウン"
        Else
            Cells(i, 3).Value = "PC立ち上げ中"
        End If
        ' コマンドの初期化
        Set wsh = Nothing
    
    Next
    
    MsgBox "確認完了", vbInformation
    
End Sub

参考にしたサイト

algorithm.joho.info
というかまんまこれパクリ(すみません)

www.infraexpert.com
オプションを何も指定しない状態だと正常でも見つからなかった場合も
4秒間タイムアウトを待つので-wオプションでミリ秒数を変更します

officetanaka.net
前も強制的にメモ帳立ち上げてなんかするときに使ったな…。

win.just4fun.biz