Use Excel 2010 VBA to ping a server and return up/down


New Member
Aug 22, 2014
I have a list of servers that I would like to find out if they are on or not. I want to do this by pinging each server. On my work laptop I have the permissions necessary to ping each server individually in CMD and Powershell, but I cannot execute any scripts to allow me to automate the process.

I found this old thread from 7 years ago which seemed to answer the question -

But when I attempted to use the code, I get this error:

Any help is appreciated!
Last edited:

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.


New Member
Aug 22, 2014
This works perfectly. Thanks so much!

Final code I used:

   'This function does the pinging
   Function GetPingResult(Host)
   'declaring variables
   Dim objPing As Object
   Dim objStatus As Object
   Dim Result As String
   'ping the host
   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
       ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")
   'report the results
   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
   'reset object ping variable
   Set objPing = Nothing

End Function

'this sub calls the above function using a for each loop
Sub GetIPStatus()

'this clears the current Ping Status column (not necessary but visually helpful

'declaring variables
  Dim Cell As Range
  Dim ipRng As Range
  Dim Result As String
  Dim Wks As Worksheet
  Dim StartTime As Double
  Dim SecondsElapsed As Double

'this starts a time to see how long the status check takes
StartTime = Timer

'setting values of variables
Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))

'this is a loop that feeds each server from the list into the GetPingResult function
  For Each Cell In ipRng
    Result = GetPingResult(Cell)
    Cell.Offset(0, 1) = Result
  Next Cell

'this calculates the time it took to run the script and converts it to minutes
SecondsElapsed = Round(Round(Timer - StartTime, 2) / 60)

'this displays the final time taken and lets the user know everything has completed
MsgBox "This code ran successfully in " & SecondsElapsed & " minutes", vbInformation

End Sub
Last edited:

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...