Excel – Ping List and Return Status
Code snippet to return IP and Hostname lookup in excel. Change the sheet name and ranges as needed. Can take some time to run on big lists!
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
Function GetPingResult(Host) 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 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 |