Windows 在过程中卡住/卡住时向前移动宏

我编写了一个宏，它使用

paping.exe

程序通过发送ping并记录其返回值来循环浏览设备IP地址列表。虽然宏在大多数时间都按预期工作，但当

ping

命令出现卡滞或卡住并停止向前移动时，会有一些空闲时间。这导致我不得不手动中断执行并重新启动流程

从更广泛的角度来看，是否有办法处理此

运行时
错误。我的想法是将设备列表分成若干组，如果程序卡住，我可以告诉宏继续下一组。虽然只是一个无聊的想法，但我想向社区寻求建议、技巧和想法，让我能够更雄辩地处理这个问题。我正在ping的设备列表也将随着时间的推移而增加

公共子getPingStatusCode（IPvalue为字符串，portValue为字符串）
ret=WshShell.Run（“C:\Users\******\paping.exe”&IPvalue&&p&portValue&&C&pingCount&&pingTime，0，True）”changeeee
totalCounter=totalCounter+1
选择案例ret
案例0:strResult=“已连接”
案例1:strResult=“失败”
案例11001:strResult=“缓冲区太小”
案例11002:strResult=“无法到达目的地网络”
案例11003:strResult=“无法访问目标主机”
案例11004:strResult=“无法访问目标协议”
案例11005:strResult=“无法访问目标端口”
案例11006:strResult=“无资源”
案例11007:strResult=“坏选项”
案例11008:strResult=“硬件错误”
案例11009:strResult=“数据包太大”
案例11010:strResult=“请求超时”
案例11011:strResult=“错误请求”
案例11012:strResult=“错误路线”
案例11013:strResult=“TTL过期运输”
案例11014:strResult=“TTL过期重新组装”
案例11015:strResult=“参数问题”
案例11016:strResult=“源淬火”
案例11017:strResult=“选项太大”
案例11018:strResult=“目的地错误”
案例11032:strResult=“协商IPSEC”
案例11050:stresult=“一般故障”
案例：strResult=“未知主机”
结束选择
'关于粗体和字体颜色返回值的if语句
”“还有柜台
如果ret=0，则“已连接”
带pingSheet.Cells（i，4）
.Value=strResult
以
totalOn=totalOn+1
onOff=1
'将rawdata表值设置为已连接状态…假定该表以所有rawdata值为“已连接”开始
rawDataSheet.Cells（4，i）.Value=stresult
ElseIf ret=1，则“失败”
带pingSheet.Cells（i，4）
.Value=strResult
.Font.Color=vbRed
.Font.bold=True
以
故障计数器=故障计数器+1
onOff=0
'给原始数据表一个“自”日期值
如果rawDataSheet.Cells（4，i）.Value=“已连接”，则
rawDataSheet.Cells（4，i）.Value=Now
如果结束
''''''''''''''
pdfDeviceDump
其他的
带pingSheet.Cells（i，4）
.Value=strResult
.Font.Color=vbRed
.Font.bold=True
以
故障计数器=故障计数器+1
onOff=0
如果结束
端接头
我无法在我的机器上运行
paping.exe
，因此我使用
ping.exe
编写了一些代码

原则上，我们可以将输出抛出并重定向到文件，然后在完成后提取文件。我们使用Windows API调用来等待进程完成

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

选项显式
私有声明函数OpenProcess Lib“kernel32”（ByVal dwDesiredAccess为Long，ByVal bInheritHandle为Long，ByVal dwProcessId为Long）为Long
私有声明函数CloseHandle Lib“kernel32”（ByVal hObject As Long）为Long
私有声明函数WaitForSingleObject Lib“kernel32.dll”（ByVal hHandle长，ByVal DW毫秒长）长
私有常量无限=&HFFFF
私有常量进程\u所有\u访问=&H1F0FFF
子TestShellandDirectpingToFile（）
作为变体的暗淡Vipaddress
vIPAddresses=Array（“bbc.co.uk”、“wikipedia.org”、“cnn.com”）
Dim dicFilesToPickUp作为脚本.Dictionary
设置dicFilesToPickUp=ShellandDirectpingToFile（vIPAddresses）
Dim vKeyLoop作为变型
对于dicFilesToPickUp.Keys中的每个vKeyLoop
暗lPID与长lPID相同
lPID=dicFilesToPickUp.Item（vKeyLoop）
暗淡的hProc如长
hProc=OpenProcess（PROCESS\u ALL\u访问，0&，lPID）
Debug.Print“Waiting on”&vKeyLoop&“（&lPID&”）命令
WaitForSingleObject hProc，无限
CloseHandle hProc'*友好地关闭手柄
下一个
Debug.Print“完成！准备读取文件”
端接头
函数ShellandDirectpingToFile（ByVal vIPAddresses作为变体）作为脚本。字典
Dim dicFilesToPickUp作为脚本.Dictionary
Set dicFilesToPickUp=New Scripting.Dictionary
Dim sTempFolder作为字符串
sTempFolder=Environ$（“TEMP”）
如果右$（sTempFolder，1）“\”则sTempFolder=sTempFolder&“\”
Dim vAddressLoop作为变量
对于VipAddress中的每个VadAddressLoop
Dim sTempFile作为字符串
sTempFile=sTempFolder&vAddressLoop&“.txt”
作为字符串的Dim sCmd
sCmd=Environ$（“comspec”）&/S/C ping.exe“&vAddressLoop&“>”&sTempFile
暗lPID与长lPID相同
lPID=VBA.Shell（sCmd）
添加sTempFile，lPID
下一个
设置ShellandDirectPingToFile=dicFilesToPickUp
端函数
如果你没有绑定到paping：我不熟悉
paping.exe
，但在WMI中执行此操作的代码看起来无论如何都会更短：如果你没有绑定到同步处理：@Comintern我喜欢链接中的想法，但是，考虑到我的技能，它有点高级。如果您对异步ping有更简单的理解，请让我知道。@Comintern再看一眼，我注意到解决方案实际上是您的。Wou