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.
1 comment
10 years on the last publication, and your script is still of tremendous use. I use VBA to get my things done using my VB6 programming experience of early 2000 years and code snippets available on internet. You just made my life easier today as I have been using a combination of nslookup and ping results dumped to files and then processing these files to get the desired results. Your script does not require me to do that anymore. Many thanks again.