1

I am looking to automate a process where I can run through a list of devices, ping them, and learn if they are up (meaning they are communicating) or down (no successful ping). I have looked at some tutorials and plans and have made it to the following script.

I may be getting confused between the shell function and what I have below. I understood it to be that in my ret value returns as 0, the ping was a fail. But rather, I think I am wrong on that. Can anybody offer me clarity on this issue of the function and how to work with return values. Better yet, has anyone ever tried to create something similar to what I am doing?

Sub testPing()

    Dim WshShell
    Set WshShell = VBA.CreateObject("WScript.Shell")

    Dim testIP As String
    Dim testPort As String

    Dim yes, no As String
    yes = "true"
    no = "false"

    testIP = Cells(3, 2).Value
    testPort = Cells(3, 3).Value

    ret = WshShell.Run("C:\Users\John.Doe\paping.exe " & testIP & " -p " & testPort & " -c 3", 0, True)

    Debug.Print ret

End Sub
Rivers31334
  • 644
  • 1
  • 12
  • 30

1 Answers1

2

Code adapted from This Question

Use this function

Function GetPingResult(Host)
   Dim objPing As Object
   Dim objStatus As Object
   Dim Result As String

   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
       ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

   For Each objStatus In objPing
      Select Case objStatus.StatusCode
         Case 0: strResult = "Connected"
         Case 11001: strResult = "Buffer too small"
         Case 11002: strResult = "Destination net unreachable"
         Case 11003: strResult = "Destination host unreachable"
         Case 11004: strResult = "Destination protocol unreachable"
         Case 11005: strResult = "Destination port unreachable"
         Case 11006: strResult = "No resources"
         Case 11007: strResult = "Bad option"
         Case 11008: strResult = "Hardware error"
         Case 11009: strResult = "Packet too big"
         Case 11010: strResult = "Request timed out"
         Case 11011: strResult = "Bad request"
         Case 11012: strResult = "Bad route"
         Case 11013: strResult = "Time-To-Live (TTL) expired transit"
         Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
         Case 11015: strResult = "Parameter problem"
         Case 11016: strResult = "Source quench"
         Case 11017: strResult = "Option too big"
         Case 11018: strResult = "Bad destination"
         Case 11032: strResult = "Negotiating IPSEC"
         Case 11050: strResult = "General failure"
         Case Else: strResult = "Unknown host"
      End Select
      GetPingResult = strResult
   Next

   Set objPing = Nothing
End Function

Loop through range of IP addresses and place result in adjacent cell like this:

Sub GetIPStatus()
  Dim cell As Range

  For Each cell In Worksheets("Sheet1").Range("A1:A5")
    Result = GetPingResult(cell.Value)
    cell.Offset(0, 1).Value = Result
  Next cell
End Sub

Result

enter image description here

Community
  • 1
  • 1
Automate This
  • 30,726
  • 11
  • 60
  • 82
  • 1
    @ThunderFrame Agreed, but I thought I'd do it out of principle :-) – Automate This Nov 07 '16 at 23:34
  • Thanks for posting this, it is very helpful. What is the code inside the `GetObject`. The `("winmgmts:{impersonationLevel=impersonate}` portion. – Rivers31334 Nov 08 '16 at 04:20
  • @PortlandRunner I am working with this and editing to my needs. I really appreciate it but I am getting a Run-time `-1147217407 Automation Error`. Do you know any fixes or reasoning? – Rivers31334 Nov 08 '16 at 14:40
  • winmgmts is Windows Management Instrumentation, which provides a powerful and extensive method to access information and specifications about your computer, operating system, and installed software. The impersonation level is a security layer to allow access to certain information on your local computer. Here is a fairly [good post about WMI](http://www.makeuseof.com/tag/see-pc-information-using-simple-excel-vba-script/) with several examples if your interested. – Automate This Nov 08 '16 at 15:04
  • When debugging, what line does the error occur? Sometimes automation errors can be solved by copying the code into a new module and deleting the old module. I know it's weird but it works occasionally when there appears to be nothing wrong with the code itself. – Automate This Nov 08 '16 at 15:08