pingコマンドを利用した起動端末の調査

起動しているIT機器の一覧を抽出したい
IPアドレス一覧からオンライン端末を抽出する

起動しているIT機器の一覧を抽出したい

凛（りん）

先輩、現在起動されているパソコンの一覧を素早く抽出する方法はありますか？法定点検等の対応でシャットダウンされていないパソコンを素早く調査したくって…

陽（はる）

確かに、頻度は多くないけど調査したいことはちょくちょくあるよね。そんなときのために、IPアドレスの台帳一覧から、現在立ち上がっている（ping応答がある）端末を検索するツールをExcelVBAで作成しておいたよ。

凛（りん）

おぉ、さすがです！

陽（はる）

作成したプログラムについて説明していくね。

IPアドレス一覧からオンライン端末を抽出する

陽（はる）

A列にIPアドレスを入力し実行ボタンを押すと、A列のIPアドレスに対して順番にpingコマンドを実行しB列に結果を格納するようにしたよ。

陽（はる）

実行ボタンを押すとこんな感じだね。ちなみに「A列、B列、F1、G1」以外は使用していないから自分で項目を追加することも可能だよ。

凛（りん）

おぉ、いい感じですね。F列に、合計台数と現在実行中の数。G列に結果が表示される形ですね。

陽（はる）

そうそう。ソースコードを載せておくから、使用する場合はExcelを立ち上げて、標準モジュールに貼り付けて実行してみてね。

Option Explicit

Private Enum Columns
    ip = 1   'A列'
    on_off = 2 'B列'
    nowCnt = 6 'F列'
    onCnt = 7 'G列'
End Enum

Sub startPing()

'フォントの色はここで規定===
Dim defaultFont As Long
defaultFont = RGB(0, 0, 0)  'フォント色の初期を規定

Dim onlineFont As Long
onlineFont = RGB(0, 200, 0) 'オンライン時のフォント色を規定

Dim offlineFont As Long
offlineFont = RGB(240, 0, 0)    'オフライン時のフォント色を規定
'===

Dim onOffRow As Long
Dim lastRowIP As Long
Dim i As Long
Dim ipAddress As String

'IPアドレス列の最終行を取得。
lastRowIP = Cells(Rows.Count, Columns.ip).End(xlUp).Row

Do
    For onOffRow = 2 To lastRowIP

'オンライン数を表示。
        With Cells(1, Columns.onCnt)
            .Font.Bold = True
            .Font.Color = onlineFont
            .Value = "オン" & "=" & _
                WorksheetFunction.CountIf(Range(Cells(2, Columns.on_off), Cells(Rows.Count, Columns.on_off)), "オン")
        End With

'総数から現在のping回数を表示。
        i = i + 1
        With Cells(1, Columns.nowCnt)
            .Font.Bold = True
            .numberFormatLocal = "@"
            .Value = i & "/" & _
                WorksheetFunction.Subtotal(3, Range(Cells(2, Columns.ip), Cells(Cells(Rows.Count, Columns.ip).End(xlUp).Row, Columns.ip)))
        End With

'非表示列は無視する。
        Do While Rows(onOffRow).Hidden
            onOffRow = onOffRow + 1
        Loop

'IPアドレスを取得し、ping疎通の確認。
        ipAddress = Cells(onOffRow, Columns.ip).Value

'結果から、オンかオフを判定。
        If pingResult(ipAddress) = True Then
            With Cells(onOffRow, Columns.on_off)
                .Font.Bold = True
                .Value = "オン"
                .Font.Color = onlineFont
            End With
        
        Else
            With Cells(onOffRow, Columns.on_off)
                .Font.Bold = True
                .Value = "オフ"
                .Font.Color = offlineFont
            End With
        End If

'停止ボタンが押されたら、処理を終了する。
        If Cells(1, Columns.nowCnt).Value = "停止" Then
            Exit Sub
        End If
        
    Next

'停止ボタンが押されるまで、処理をループする。
Loop Until Cells(1, Columns.nowCnt).Value = "停止"

End Sub

Private Function pingResult(ipAddress)  'ping結果をTrue or FalseでpingResultに返す。

Dim objShell As Object
Dim rc As Boolean
Set objShell = CreateObject("Wscript.Shell")

rc = objShell.Run("ping -n 1 -w 1000 " & ipAddress, 0, True)    'ping疎通があった場合はFalse、なかった場合はTrueを返す。

Select Case rc
    Case False  'ping疎通があった場合
        pingResult = True
    Case Else   'ping疎通がなかった場合
        pingResult = False
End Select

End Function

Sub stopPing()  '処理停止ボタン

    Cells(1, Columns.nowCnt).Value = "停止"
    
End Sub

100

101

102

103

104

105

106

107

108

Option Explicit

Private Enum Columns

ip = 1 'A列'

on_off = 2 'B列'

nowCnt = 6 'F列'

onCnt = 7 'G列'

End Enum

Sub startPing()

'フォントの色はここで規定===

Dim defaultFont As Long

defaultFont = RGB(0, 0, 0) 'フォント色の初期を規定

Dim onlineFont As Long

onlineFont = RGB(0, 200, 0) 'オンライン時のフォント色を規定

Dim offlineFont As Long

offlineFont = RGB(240, 0, 0) 'オフライン時のフォント色を規定

'===

Dim onOffRow As Long

Dim lastRowIP As Long

Dim i As Long

Dim ipAddress As String

'IPアドレス列の最終行を取得。

lastRowIP = Cells(Rows.Count, Columns.ip).End(xlUp).Row

For onOffRow = 2 To lastRowIP

'オンライン数を表示。

With Cells(1, Columns.onCnt)

.Font.Bold = True

.Font.Color = onlineFont

.Value = "オン" & "=" & _

WorksheetFunction.CountIf(Range(Cells(2, Columns.on_off), Cells(Rows.Count, Columns.on_off)), "オン")

End With

'総数から現在のping回数を表示。

i = i + 1

With Cells(1, Columns.nowCnt)

.Font.Bold = True

.numberFormatLocal = "@"

.Value = i & "/" & _

WorksheetFunction.Subtotal(3, Range(Cells(2, Columns.ip), Cells(Cells(Rows.Count, Columns.ip).End(xlUp).Row, Columns.ip)))

End With

'非表示列は無視する。

Do While Rows(onOffRow).Hidden

onOffRow = onOffRow + 1

Loop

'IPアドレスを取得し、ping疎通の確認。

ipAddress = Cells(onOffRow, Columns.ip).Value

'結果から、オンかオフを判定。

If pingResult(ipAddress) = True Then

With Cells(onOffRow, Columns.on_off)

.Font.Bold = True

.Value = "オン"

.Font.Color = onlineFont

End With

Else

With Cells(onOffRow, Columns.on_off)

.Font.Bold = True

.Value = "オフ"

.Font.Color = offlineFont

End With

End If

'停止ボタンが押されたら、処理を終了する。

If Cells(1, Columns.nowCnt).Value = "停止" Then

Exit Sub

End If

'停止ボタンが押されるまで、処理をループする。

Loop Until Cells(1, Columns.nowCnt).Value = "停止"

End Sub

Private Function pingResult(ipAddress) 'ping結果をTrue or FalseでpingResultに返す。

Dim objShell As Object

Dim rc As Boolean

Set objShell = CreateObject("Wscript.Shell")

rc = objShell.Run("ping -n 1 -w 1000 " & ipAddress, 0, True) 'ping疎通があった場合はFalse、なかった場合はTrueを返す。

Select Case rc

Case False 'ping疎通があった場合

pingResult = True

Case Else 'ping疎通がなかった場合

pingResult = False

End Select

End Function

Sub stopPing() '処理停止ボタン

Cells(1, Columns.nowCnt).Value = "停止"

End Sub

なこあ

※Sampleと同じように、実行ボタンと停止ボタンをつけたい場合は

実行ボタンに、startPingプロシージャ
停止ボタンに、stopPingプロシージャ

を割り当ててください。

なこあ

あと、Excel上部のタブから「表示→ウィンドウ枠の固定→先頭行の固定」を行っておくと見やすくなります。
※エラー処理は入れていないため、必要であれば適宜追加を行ってください。

月	火	水	木	金	土	日
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30	31