Move macro forward when caught/stuck in process - windows

Question

I have written a macro that uses the paping.exe program to cycle through a list of device IP addresses by sending pings and recording their return values. While the macro works as intended for the majority of the time, there are spare moments when the ping command appears to be stuck or caught up and stops moving forward. This causes me to have to manually break the execution and start the process over.
From a more broad perspective, is there a way to handle this runtime error. My thought was to break the list of devices into groupings, and if the program becomes stuck, I could tell the macro to move forward to the next grouping. While just an idle idea, I wanted to reach out to the community for advice, tips and ideas on ways I could more eloquently handle this issue. The list of devices that I am pinging is set to grow in time as well.
Public Sub getPingStatusCode(IPvalue As String, portValue As String)
ret = WshShell.Run("C:\Users\*******\paping.exe " & IPvalue & " -p " & portValue & " -c " & pingCount & " -t " & pingTime, 0, True) 'CHANGEEEEEEE
totalCounter = totalCounter + 1
Select Case ret
Case 0: strResult = "Connected"
Case 1: strResult = "Fail"
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 = "TTL expired transit"
Case 11014: strResult = "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
'if statement on return value for bolding and font color
'and counters
If ret = 0 Then 'CONNECTED
With pingSheet.Cells(i, 4)
.Value = strResult
End With
totalOn = totalOn + 1
onOff = 1
'set the rawDataSheet value to connected status...assumes that the sheet starts with all rawdata values as "connected"
rawDataSheet.Cells(4, i).Value = strResult
ElseIf ret = 1 Then 'FAILED
With pingSheet.Cells(i, 4)
.Value = strResult
.Font.Color = vbRed
.Font.bold = True
End With
failCounter = failCounter + 1
onOff = 0
'give RawData sheet a "down since" date value
If rawDataSheet.Cells(4, i).Value = "Connected" Then
rawDataSheet.Cells(4, i).Value = Now
End If
''''''''''''''
pdfDeviceDump
Else
With pingSheet.Cells(i, 4)
.Value = strResult
.Font.Color = vbRed
.Font.bold = True
End With
failCounter = failCounter + 1
onOff = 0
End If
End Sub

Answer 1

I could not get paping.exe to run on my machine so I wrote some code using ping.exe instead.
In principle one can shell out and redirect output to file and then pick up the file later when finished. We use Windows API calls to wait for a process to finish.
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const INFINITE = &HFFFF
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Sub TestShellAndRedirectPingToFile()
Dim vIPAddresses As Variant
vIPAddresses = Array("bbc.co.uk", "wikipedia.org", "cnn.com")
Dim dicFilesToPickUp As Scripting.Dictionary
Set dicFilesToPickUp = ShellAndRedirectPingToFile(vIPAddresses)
Dim vKeyLoop As Variant
For Each vKeyLoop In dicFilesToPickUp.Keys
Dim lPID As Long
lPID = dicFilesToPickUp.Item(vKeyLoop)
Dim hProc As Long
hProc = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPID)
Debug.Print "Waiting on " & vKeyLoop & " (" & lPID & ")"
WaitForSingleObject hProc, INFINITE
CloseHandle hProc '* be nice and close handles
Next
Debug.Print "Done! Files ready to read."
End Sub
Function ShellAndRedirectPingToFile(ByVal vIPAddresses As Variant) As Scripting.Dictionary
Dim dicFilesToPickUp As Scripting.Dictionary
Set dicFilesToPickUp = New Scripting.Dictionary
Dim sTempFolder As String
sTempFolder = Environ$("TEMP")
If Right$(sTempFolder, 1) <> "\" Then sTempFolder = sTempFolder & "\"
Dim vAddressLoop As Variant
For Each vAddressLoop In vIPAddresses
Dim sTempFile As String
sTempFile = sTempFolder & vAddressLoop & ".txt"
Dim sCmd As String
sCmd = Environ$("comspec") & " /S /C ping.exe " & vAddressLoop & " > " & sTempFile
Dim lPID As Long
lPID = VBA.Shell(sCmd)
dicFilesToPickUp.Add sTempFile, lPID
Next
Set ShellAndRedirectPingToFile = dicFilesToPickUp
End Function