Updated PingCell Function for Excel
This post was previously released under a different blog and is being republished by me below. That site is no longer available. I am the original author.
I’ve updated my Microsoft Excel PingCell code that I published previously. 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.
1Public Sub PingCell()
2
3 ' Version: 1.1
4 ' Excel Version: Tested with 2003/2007
5 ' Language: English
6 ' Description: Function that pings a computer and returns the result to an adjacent column
7
8 ' 30-Jun-2009: Created Function
9 ' 23-Aug-2009: Added all other Win32\_PingStatus results to Excel
10
11 Dim column As Integer
12 Dim strStatus As String
13 Dim objPing As Object
14 Dim objPingStatus As Object
15 Dim r As Range
16
17 ' Ask user for column number to return results to
18 column = InputBox("Please select a column NUMBER to start the dump:", "Ping Systems")
19
20 For Each r In Application.Selection
21
22 Cells(r.Row, column + 0) = "Pinging ..."
23 Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select \* from Win32\_PingStatus where address = '" & r.Value & "'")
24
25 ' Call DoEvents to stop this thing from hanging Excel on long lists
26 DoEvents
27
28 For Each objPingStatus In objPing
29 ' Status Codes: http://msdn.microsoft.com/en-us/library/aa394350%28VS.85%29.aspx
30 If IsNull(objPingStatus.statuscode) Then
31 ' Not from MSDN
32 strStatus = "Unable to Resolve Host"
33 Else
34 Select Case objPingStatus.statuscode
35 Case 0
36 strStatus = "Success"
37 Case 11002
38 strStatus = "Destination Net Unreachable"
39 Case 11003
40 strStatus = "Destination Host Unreachable"
41 Case 11004
42 strStatus = "Destination Protocol Unreachable"
43 Case 11005
44 strStatus = "Destination Port Unreachable"
45 Case 11006
46 strStatus = "No Resources"
47 Case 11007
48 strStatus = "Bad Option"
49 Case 11008
50 strStatus = "Hardware Error"
51 Case 11009
52 strStatus = "Packet Too Big"
53 Case 11010
54 strStatus = "Request Timed Out"
55 Case 11011
56 strStatus = "Bad Request"
57 Case 11012
58 strStatus = "Bad Route"
59 Case 11013
60 strStatus = "TimeToLive Expired Transit"
61 Case 11014
62 strStatus = "TimeToLive Expired Reassembly"
63 Case 11015
64 strStatus = "Parameter Problem"
65 Case 11016
66 strStatus = "Source Quench"
67 Case 11017
68 strStatus = "Option Too Big"
69 Case 11018
70 strStatus = "Bad Destination"
71 Case 11032
72 strStatus = "Negotiating IPSEC"
73 Case 11050
74 strStatus = "General Failure"
75 Case Else
76 strStatus = "Unknown Ping Result (" & objPingStatus.statuscode & ")"
77 End Select
78 End If
79
80 Cells(r.Row, column + 0) = strStatus
81 Cells(r.Row, column + 1) = objPingStatus.BufferSize
82 Cells(r.Row, column + 2) = objPingStatus.NoFragmentation
83 Cells(r.Row, column + 3) = objPingStatus.PrimaryAddressResolutionStatus
84 Cells(r.Row, column + 4) = objPingStatus.ProtocolAddress ' IP Address
85 Cells(r.Row, column + 5) = objPingStatus.ProtocolAddressResolved
86 Cells(r.Row, column + 6) = objPingStatus.RecordRoute
87 Cells(r.Row, column + 7) = objPingStatus.ReplyInconsistency
88 Cells(r.Row, column + 8) = objPingStatus.ReplySize
89 Cells(r.Row, column + 9) = objPingStatus.ResolveAddressNames
90 Cells(r.Row, column + 10) = objPingStatus.ResponseTime
91 Cells(r.Row, column + 11) = objPingStatus.ResponseTimeToLive
92 Cells(r.Row, column + 12) = objPingStatus.RouteRecord
93 Cells(r.Row, column + 13) = objPingStatus.RouteRecordResolved
94 Cells(r.Row, column + 14) = objPingStatus.SourceRoute
95
96 Select Case objPingStatus.SourceRouteType
97 Case 0
98 strStatus = "None"
99 Case 1
100 strStatus = "Loose Source Routing"
101 Case 2
102 strStatus = "Strict Source Routing"
103 Case Else
104 strStatus = "Unknown Source Routing"
105 End Select
106
107 Cells(r.Row, column + 15) = strStatus
108 Cells(r.Row, column + 16) = objPingStatus.Timeout
109 Cells(r.Row, column + 17) = objPingStatus.TimeStampRecord
110 Cells(r.Row, column + 18) = objPingStatus.TimeStampRecordAddress
111 Cells(r.Row, column + 19) = objPingStatus.TimeStampRecordAddressResolved
112 Cells(r.Row, column + 20) = objPingStatus.TimeStampRoute
113 Cells(r.Row, column + 21) = objPingStatus.TimeToLive
114
115 Select Case objPingStatus.TimeStampRoute
116 Case 0
117 strResult = "Normal"
118 Case 2
119 strResult = "Minimize Monitary Cost"
120 Case 4
121 strResult = "Maximize Reliability"
122 Case 8
123 strResult = "Maximize Throughput"
124 Case 16
125 strResult = "Minimize Delay"
126 Case Else
127 strResult = "Unknown"
128 End Select
129
130 Cells(r.Row, column + 22) = strResult
131
132 Next
133
134 Next r
135
136End 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:
1Cells(r.Row, column + 0) = strStatus
2Cells(r.Row, column + 4) = objPingStatus.ProtocolAddress
You can then change the column+4 to column+1 so that they sit next to each other.