Updated PingCell Function for Excel
August 23rd, 2009
I’ve updated my Microsoft Excel PingCell code that I wrote for this post. The new function returns all results from Win32_PingStatus back to Excel. You can now ping and choose the results you’d like to see returned (example below code). The Win32_PingStatus class is documented on Microsoft’s Website.
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 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | Public Sub PingCell() ' Version: 1.1 ' Excel Version: Tested with 2003/2007 ' Language: English ' Description: Function that pings a computer and returns the result to an adjacent column ' http://www.TechnicallyChris.com/ ' 30-Jun-2009: Created Function ' 23-Aug-2009: Added all other Win32_PingStatus results to Excel Dim column As Integer Dim strStatus As String Dim objPing As Object Dim objPingStatus As Object Dim r As Range ' Ask user for column number to return results to column = InputBox("Please select a column NUMBER to start the dump:", "Ping Systems") For Each r In Application.Selection Cells(r.Row, column + 0) = "Pinging ..." Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & r.Value & "'") ' Call DoEvents to stop this thing from hanging Excel on long lists DoEvents For Each objPingStatus In objPing ' Status Codes: http://msdn.microsoft.com/en-us/library/aa394350%28VS.85%29.aspx If IsNull(objPingStatus.statuscode) Then ' Not from MSDN strStatus = "Unable to Resolve Host" Else Select Case objPingStatus.statuscode Case 0 strStatus = "Success" Case 11002 strStatus = "Destination Net Unreachable" Case 11003 strStatus = "Destination Host Unreachable" Case 11004 strStatus = "Destination Protocol Unreachable" Case 11005 strStatus = "Destination Port Unreachable" Case 11006 strStatus = "No Resources" Case 11007 strStatus = "Bad Option" Case 11008 strStatus = "Hardware Error" Case 11009 strStatus = "Packet Too Big" Case 11010 strStatus = "Request Timed Out" Case 11011 strStatus = "Bad Request" Case 11012 strStatus = "Bad Route" Case 11013 strStatus = "TimeToLive Expired Transit" Case 11014 strStatus = "TimeToLive Expired Reassembly" Case 11015 strStatus = "Parameter Problem" Case 11016 strStatus = "Source Quench" Case 11017 strStatus = "Option Too Big" Case 11018 strStatus = "Bad Destination" Case 11032 strStatus = "Negotiating IPSEC" Case 11050 strStatus = "General Failure" Case Else strStatus = "Unknown Ping Result (" & objPingStatus.statuscode & ")" End Select End If Cells(r.Row, column + 0) = strStatus Cells(r.Row, column + 1) = objPingStatus.BufferSize Cells(r.Row, column + 2) = objPingStatus.NoFragmentation Cells(r.Row, column + 3) = objPingStatus.PrimaryAddressResolutionStatus Cells(r.Row, column + 4) = objPingStatus.ProtocolAddress ' IP Address Cells(r.Row, column + 5) = objPingStatus.ProtocolAddressResolved Cells(r.Row, column + 6) = objPingStatus.RecordRoute Cells(r.Row, column + 7) = objPingStatus.ReplyInconsistency Cells(r.Row, column + 8) = objPingStatus.ReplySize Cells(r.Row, column + 9) = objPingStatus.ResolveAddressNames Cells(r.Row, column + 10) = objPingStatus.ResponseTime Cells(r.Row, column + 11) = objPingStatus.ResponseTimeToLive Cells(r.Row, column + 12) = objPingStatus.RouteRecord Cells(r.Row, column + 13) = objPingStatus.RouteRecordResolved Cells(r.Row, column + 14) = objPingStatus.SourceRoute Select Case objPingStatus.SourceRouteType Case 0 strStatus = "None" Case 1 strStatus = "Loose Source Routing" Case 2 strStatus = "Strict Source Routing" Case Else strStatus = "Unknown Source Routing" End Select Cells(r.Row, column + 15) = strStatus Cells(r.Row, column + 16) = objPingStatus.Timeout Cells(r.Row, column + 17) = objPingStatus.TimeStampRecord Cells(r.Row, column + 18) = objPingStatus.TimeStampRecordAddress Cells(r.Row, column + 19) = objPingStatus.TimeStampRecordAddressResolved Cells(r.Row, column + 20) = objPingStatus.TimeStampRoute Cells(r.Row, column + 21) = objPingStatus.TimeToLive Select Case objPingStatus.TimeStampRoute Case 0 strResult = "Normal" Case 2 strResult = "Minimize Monitary Cost" Case 4 strResult = "Maximize Reliability" Case 8 strResult = "Maximize Throughput" Case 16 strResult = "Minimize Delay" Case Else strResult = "Unknown" End Select Cells(r.Row, column + 22) = strResult Next Next r End Sub |
To restrict the results returned to just what you want, modify the rows where Cells(r.row, column+n) are set. For example, to return just the status and the IP Address, you’d remove all except for these two:
81 82 | Cells(r.Row, column + 0) = strStatus
Cells(r.Row, column + 4) = objPingStatus.ProtocolAddress |
You can then change the column+4 to column+1 so that they sit next to each other.
Great work!
This is JUST the thing I needed. However, as soon as the screen locks (forced automatically on my laptop) the code stops executing. I have a long list of IP’s that I’d like to ping but I can’t let it run overnight for example because it keeps stopping. Any suggestions to keep it running while the screen lock is on? Thx