verynewtovba
New Member
- Joined
- Oct 7, 2016
- Messages
- 5
Hello,
I have this script which is very good and is helpful with the audit I am carrying out, however I was wondering if someone could help with a couple of small improvements.
***************************************
***************************************
I'm using Excel2010. At the moment it works fine in that it will ping the IP addresses in column A and update the adjacent cell in column B with the responses, however;
1) in my spreadsheet, in column A, there are many random blank cells which results in the output showing as "connected" which is incorrect since there is no IP address in the cell in column A, it really only needs to say "connected" when there is an actual response from an IP address that is in a cell in column A.
2) when the IP address in a cell in column A is tested, and the actual ICMP reply is Reply from <ip address="">: Destination host unreachable, then the text entered in the cell in column B is just "Destination host unreachable" as seen from the line Case 11003
My request is;
For 1), is it possible to make the output in the cell of column B, for an empty cell in column A, to be something like "No IP address"
For 2), is it possible to populate the cell in column B with the actual ping (icmp) reply and not just the objStatus.StatusCode, ie; Reply from < the real ip address>: Destination host unreachable
Also;
It would be great if I could change the ping variables to make it quicker by using ping -n 1 -w 250, rather than the standard windows 3 pings and wait time.
It would be good to be able to see the progress through the worksheet with something like an Application.StatusBar = "Pinging " & i - 2 & " of " & iTotal & " - " & Format((i - 2) / iTotal, "Percent") & " ... " & IP, however I don't know where in the script this would go.
Many thanks for any assistance
Best regards</ip>
I have this script which is very good and is helpful with the audit I am carrying out, however I was wondering if someone could help with a couple of small improvements.
***************************************
Code:
'This function does the pinging
Function GetPingResult(Host)
'declaring variables
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("B3:B3000").Clear
'declaring variables
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("A3:A3000")
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
I'm using Excel2010. At the moment it works fine in that it will ping the IP addresses in column A and update the adjacent cell in column B with the responses, however;
1) in my spreadsheet, in column A, there are many random blank cells which results in the output showing as "connected" which is incorrect since there is no IP address in the cell in column A, it really only needs to say "connected" when there is an actual response from an IP address that is in a cell in column A.
2) when the IP address in a cell in column A is tested, and the actual ICMP reply is Reply from <ip address="">: Destination host unreachable, then the text entered in the cell in column B is just "Destination host unreachable" as seen from the line Case 11003
My request is;
For 1), is it possible to make the output in the cell of column B, for an empty cell in column A, to be something like "No IP address"
For 2), is it possible to populate the cell in column B with the actual ping (icmp) reply and not just the objStatus.StatusCode, ie; Reply from < the real ip address>: Destination host unreachable
Also;
It would be great if I could change the ping variables to make it quicker by using ping -n 1 -w 250, rather than the standard windows 3 pings and wait time.
It would be good to be able to see the progress through the worksheet with something like an Application.StatusBar = "Pinging " & i - 2 & " of " & iTotal & " - " & Format((i - 2) / iTotal, "Percent") & " ... " & IP, however I don't know where in the script this would go.
Many thanks for any assistance
Best regards</ip>
Last edited by a moderator: