無法更改Excel VBA IP列表中的ping超時ping

以下代碼在Excel工作表中列出IP地址列表並返回響應時間和TTL。取決於IP地址的數量，超時可以快速加起來，並等待很長時間。有什麼方法可以添加500ms的自定義超時？無法更改Excel VBA IP列表中的ping超時ping

Sub Ping_Check() 
' Based on http://social.technet.microsoft.com/Forums/en-US/ITCG/thread/e59a38e1-eaf0-4b13-af10-fd4be559f50f/ 
Dim oPing As Object 
Dim oRetStatus As Object 
Dim xCell As Range 
Dim xLast_Row As Long 
Dim xWork1 As String 

xLast_Row = ActiveSheet.Range("A1").SpecialCells(xlLastCell).Row 

Application.ScreenUpdating = False 

    For Each xCell In Range("A2:A" & xLast_Row) 
     If xCell = "" Then 
      xCell.Offset(0, 1) = "" 
     Else 
      Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & xCell & "'") 
      For Each oRetStatus In oPing 
       If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then 
        xCell.Offset(0, 1) = "N/A" 
        '11001 Buffer Too Small 
        '11002 Destination Net Unreachable 
        '11003 Destination Host Unreachable 
        '11004 Destination Protocol Unreachable 
        '11005 Destination Port Unreachable 
        '11006 No Resources 
        '11007 Bad Option 
        '11008 Hardware Error 
        '11009 Packet Too Big 
        '11010 Request Timed Out 
        '11011 Bad Request 
        '11012 Bad Route 
        '11013 TimeToLive Expired Transit 
        '11014 TimeToLive Expired Reassembly 
        '11015 Parameter Problem 
        '11016 Source Quench 
        '11017 Option Too Big 
        '11018 Bad Destination 
        '11032 Negotiating IPSEC 
        '11050 General Failure 
       Else 
        xCell.Offset(0, 1) = oRetStatus.ResponseTime & " ms ; " & oRetStatus.ResponseTimeToLive 
       End If 
      Next 
     End If 
    Next 

Application.ScreenUpdating = True 

End Sub

來源

2016-01-08 Aaron Fairfax

按照MSDN page on Win32_PingStatus有一個名爲「超時」（毫秒）屬性，很可能被改變。

試着改變你的查詢

"select * from Win32_PingStatus where TimeOut = 500 and address = '" & xCell & "'"

它看起來像默認爲1000毫秒

來源

2016-01-08 17:24:45 JNevill

你的先生，是一個很好的人。 –

無法更改Excel VBA IP列表中的ping超時ping

回答

相關問題