Ping Host Name Column A IP address Result column B Response time Column c

Hello NickMac,

Here is a macro that will read the URLs in column "A" of the active sheet. The IP address, the response time in milliseconds, and the status are returned in columns "B:D". The URLs are assumed to start in "A2" with headers in row 1. The URL should just be "www.server.com" and not include the protocol.

Ping Macro

'Written: April 07, 2011
'Author:  Leith Ross
'Summary: Reads the URLs on the ActiveSheet from column "A2" and returns the IP address,
'         response time, and status in columns "B:D". Headers are assumed to be in row 1.
'         This works code with Windows XP and later.

Sub PingTest()

  Dim Cell As Range
  Dim colPings As Object, objPing As Object, strQuery As String
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
    Set Rng = Wks.Range("A2")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
    
    For Each Cell In Rng
    
      'Define the WMI query
       strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & Cell & "'"

      'Run the WMI query
       Set colPings = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)

      'Translate the query results to either True or False
       For Each objPing In colPings
         If Not objPing Is Nothing Then
            Cell.Offset(0, 1) = objPing.ProtocolAddress
            Cell.Offset(0, 2) = objPing.ResponseTime & " ms"
            Cell.Offset(0, 3) = GetPingStatus(objPing.StatusCode)
         End If
       Next objPing
     
     Next Cell
    
End Sub

Function GetPingStatus(ByVal StatusCode As Long)

  Dim Result As String

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

End Function

Nickmac,

This is an old thread. Please create a new thread and provide a link to this one if required.