Updated PingCell Function for Excel

Share on:

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

Girish Sumaria

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.