excelvbapingsystem-administration

Ping multiple computers through Excel and return IP addresses


I have 70 computers in my network, pinging them through cmd every time.

I have this Excel sheet.
Column A: manually written computer names.
Column B: should (but doesn't) write out the IP addresses of computers in column A.
Column C: shows if computer is online or offline based on ping.
Column D: manually written usernames.

I have two working buttons, ping and stop ping.

How can I by pressing the ping button, go through all the computers in column A and show their IPs and if they are online or not, all at once?

It doesn't have to be done through Excel, if there is a better solution with a view of comp name, comp ip, online/offline. Usernames would be nice to have.

Function Ping(strip)
Dim objshell, boolcode
Set objshell = CreateObject("Wscript.Shell")
boolcode = objshell.Run("ping -n 1 -w 1000 " & strip, 0, True)
If boolcode = 0 Then
    Ping = True
Else
    Ping = False
End If
End Function
'_________________________
Sub PingSystem()
Dim strip As String
Do Until Sheet1.Range("G9").Value = "STOP"
Sheet1.Range("G9").Value = "Ping"
For introw = 1 To ActiveSheet.Cells(65536, 2).End(xlUp).Row
    strip = ActiveSheet.Cells(introw, 2).Value

    If Ping(strip) = True Then
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Online"
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 200, 0)
    Else
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(200, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Offline"
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 6
    End If
    If Sheet1.Range("G9").Value = "STOP" Then
        Exit For
    End If
Next
Loop
Sheet1.Range("G9").Value = "Stop ping"
End Sub

Sub stop_ping()
    Sheet1.Range("G9").Value = "STOP"
End Sub

image of my excel table


Solution

  • This worked for me

    Sub temp()
        Set WshShell = CreateObject("WScript.Shell")
        RowCount = Worksheets("Sheet1").UsedRange.Rows.Count
    
    For i = 1 To RowCount
        Url = Worksheets("Sheet1").Cells(i, 1).Value
        cmd = "ping " + Url
        Set WshShellExec = WshShell.Exec(cmd)
        result = WshShellExec.StdOut.ReadAll
        Worksheets("Sheet1").Cells(i, 2).Value = getIP(result)
        
        If (InStr(result, "Received = 4")) Then
            Worksheets("Sheet1").Cells(i, 3).Value = "Online"
        End If
    Next
    End Sub
    
    Function getIP(result)
        ip = Split(result, vbNewLine)(1)
        startIndex = InStr(ip, "[") + 1
        endIndex = InStr(ip, "]")
        getIP = Mid(ip, startIndex, endIndex - startIndex)
    End Function