VBA function to ping addresses - aproximete times

[thedogg]

I am trying to find the lowest time that servers respond. For this I am using the code below.

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 & "-" & objStatus.ResponseTime & "-" & objStatus.ResponseTimeToLive '
   Next
   Set objPing = Nothing
End Function



Sub Ping()
Application.ScreenUpdating = False
  Dim Cell As Range
  Dim ipRng As Range
  Dim Result As String
  Dim Wks As Worksheet

Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("B3:B6")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
  For Each Cell In ipRng
    Cell.Offset(0, 1) = Split(GetPingResult(Cell), "-")(0) 'result
    Cell.Offset(0, 2) = Split(GetPingResult(Cell), "-")(1) 'Response TIme
    Cell.Offset(0, 3) = Split(GetPingResult(Cell), "-")(2) 'TTL
  Next Cell
Application.ScreenUpdating = True
End Sub
Sub Ping()
Application.ScreenUpdating = False
  Dim Cell As Range
  Dim ipRng As Range
  Dim Result As String
  Dim Wks As Worksheet

Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("B3:B6")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
  For Each Cell In ipRng
    Cell.Offset(0, 1) = Split(GetPingResult(Cell), "-")(0) 'result
    Cell.Offset(0, 2) = Split(GetPingResult(Cell), "-")(1) 'Response TIme
    Cell.Offset(0, 3) = Split(GetPingResult(Cell), "-")(2) 'TTL
  Next Cell
Application.ScreenUpdating = True
End Sub

Is there any way to find out the approximate times? Lets say I want to ping each server more than one time (-n 10) for instance.

 

[rpaulson]

Sub Ping()
Application.ScreenUpdating = False
  Dim Cell As Range
  Dim ipRng As Range
  Dim Result As String
  Dim Wks As Worksheet

Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("B3:B6")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
For n = 0 To 9
  For Each Cell In ipRng
    Cell.Offset(0, 1 + n * 4) = Split(GetPingResult(Cell), "-")(0) 'result
    Cell.Offset(0, 2 + n * 4) = Split(GetPingResult(Cell), "-")(1) 'Response TIme
    Cell.Offset(0, 3 + n * 4) = Split(GetPingResult(Cell), "-")(2) 'TTL
  Next Cell
Next n
Application.ScreenUpdating = True
End Sub

hth, Ross