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

HunterTTP

New Member
Joined
Aug 22, 2014
Messages
18
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 - http://www.mrexcel.com/forum/excel-questions/391426-ping-list-servers-excel.html

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.

HunterTTP

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

Final code I used:


Code:
   '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
   Next
   
   '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
Worksheets("Sheet1").Range("B2:B10000").Clear


'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

Threads
1,101,810
Messages
5,483,045
Members
407,375
Latest member
achusp

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...
  • CELL FORMAT - IF CONDITION
    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...
Top