VBA中Ping主机是否连接的2种方法

时　间:2017-11-30 20:09:26
作　者:在水一方   ID：20576  城市：沈阳
摘　要:调用方法
MsgBox Pings("192.168.0.1")
或
MsgBox sPing("192.168.0.1")
正　文:

第一个函数：返回TRUE / FALSE

Public Function Pings(strMachines As String) As Boolean

    Dim aMachines() As String
    Dim machine As Variant
    Dim objPing As Object
    Dim objStatus As Object
    aMachines = Split(strMachines, ";")
    For Each machine In aMachines
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & machine & "'")
        For Each objStatus In objPing
            If IsNull(objStatus.StatusCode) or objStatus.StatusCode <> 0 Then
                Debug.Print ("machine " & machine & " is not reachable")
                Pings = False
            Else
                Pings = True
            End If
        Next
    Next
End Function

第二个函数：返回网络通畅度
Function sPing(sHost As String) As String
    Dim oPing As Object, oretStatus As Object
    Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
                ("select * from Win32_PingStatus where address = '" & sHost & "'")
    For Each oretStatus In oPing
        If IsNull(oRetStatus.StatusCode) or oretStatus.StatusCode <> 0 Then
            sPing = "Status code is " & oretStatus.StatusCode
        Else
            sPing = "Pinging " & sHost & " with " & oretStatus.BufferSize & " bytes of data:" & Chr(10)
            sPing = sPing & "Time (ms) = " & vbTab & oretStatus.ResponseTime & Chr(10)
            sPing = sPing & "TTL (s) = " & vbTab & oretStatus.ResponseTimeToLive
        End If
    Next

End Function

Access软件网官方交流QQ群 (群号:483923997) 　　　　　　Access源码网店