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

OptionExplicit

PrivateEnumColumns

ip=1 'A列'

on_off=2'B列'

nowCnt=6'F列'

onCnt=7'G列'

EndEnum

SubstartPing()

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

DimdefaultFontAsLong

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

DimonlineFontAsLong

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

DimofflineFontAsLong

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

'===

DimonOffRowAsLong

DimlastRowIPAsLong

DimiAsLong

DimipAddressAsString

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

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

ForonOffRow=2TolastRowIP

'オンライン数を表示。

WithCells(1,Columns.onCnt)

.Font.Bold=True

.Font.Color=onlineFont

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

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

EndWith

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

i=i+1

WithCells(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)))

EndWith

'非表示列は無視する。

DoWhileRows(onOffRow).Hidden

onOffRow=onOffRow+1

Loop

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

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

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

IfpingResult(ipAddress)=TrueThen

WithCells(onOffRow,Columns.on_off)

.Font.Bold=True

.Value="オン"

.Font.Color=onlineFont

EndWith

Else

WithCells(onOffRow,Columns.on_off)

.Font.Bold=True

.Value="オフ"

.Font.Color=offlineFont

EndWith

EndIf

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

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

ExitSub

EndIf

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

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

EndSub

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

DimobjShellAsObject

DimrcAsBoolean

SetobjShell=CreateObject("Wscript.Shell")

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

SelectCaserc

CaseFalse 'ping疎通があった場合

pingResult=True

CaseElse 'ping疎通がなかった場合

pingResult=False

EndSelect

EndFunction

SubstopPing() '処理停止ボタン

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

EndSub

なこあ

※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