PING MULTIPLE DEVICE (PING TeSTER)

[joshi868b]

I HAVE A TABLE IN EXCEL .ONE COLUMN CONTAINS MULTIPLE IP ADDRESS OF DEVICE. I want to ping all the device and display the result in another column and time at next column.how can i achieve this without opening the command window (Pinging take splace silently only excel sheet will be updated).Like a ping Tester.

 

[rpaulson]

look here:
Ping IP Address with VBA code and return results in Excel - Stack Overflow

 

[joshi868b]

look here:
Ping IP Address with VBA code and return results in Excel - Stack Overflow

my code is follows.But when i execute this code a black command window open and it flicker till the time all devices pings.I want to run it silently

Sub PING()
Application.ScreenUpdating = False
Dim strTarget, strPingResult, strInput, wshShell, wshExec
With Sheets(1)
shlastrow = .Cells(Rows.Count, "B").End(x1up).Row
Set shrange = .Range("B3:B7" & shlastrow)
End With
For Each shCell In shrange
strInput = shCell.Text
If strInput <> "" Then
strTarget = strInput
setwshshell = CreateObject("wscript.shell")
Set wshExec = wshShell.exec("ping -n 2 -w 5 " & strTarget)
strPingResult = LCase(wshExec.stdout.readall)
If InStr(strPingResult, "reply from") Then
shCell.Offset(0, 1).Value = "Reachable"
shCell.Offset(0, 2).Value = "Time"
Else
shCell.Offset(0, 1).Value = "UnReachable"
shCell.Offset(0, 2).Value = "Reachable"
End If
End If
Next shCell

End Sub

 

[rpaulson]

here is my code. There is no Flicker at all - it returns Status, Time and TTL

 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")
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

hth,
Ross

 

[JumboCactuar]

here is my code. There is no Flicker at all - it returns Status, Time and TTL

this works great ive been looking for something similar to this thanks

how would you use this code to just ping a single cell?

 

[rpaulson]

=GetPingResult((B3))

 

[joshi868b]

DEAR rpaulson CAN YOU SEND ME THE COMPLETE EXCEL SHEET WITH CODE BEACAUSE I COULD NOT USE THIS CODE .I AM NEW TO VBA

 

[joshi868b]

here is my code. There is no Flicker at all - it returns Status, Time and TTL

 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")
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

hth,
Ross

WHAT WIL BE THE code if I want only two option "Reachable" and Unreachable". And how can I set the ping properties like Set wshExec = wshShell.exec("ping -n 2 -w 5 " & strTarget)
in my code .

 

[mole999]

DEAR rpaulson CAN YOU SEND ME THE COMPLETE EXCEL SHEET WITH CODE BEACAUSE I COULD NOT USE THIS CODE .I AM NEW TO VBA

Please read the > http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html The forum is designed to assist learning. Being given a solution by a member off of the forum actually would breach the rules. You may start your own thread and reference this one on how you could incorporate what you would like to do, and therefore aid your learning.