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

检测某主机是否连接上时，经常使用Ping命令，但并不是一般人都会很清楚调用cmd来执行这一命令的，这里水文工具集介绍2种采用VBA来实现Ping主机是否连接的方法，第一种是通过创建Wscript.Shell对象来完成，第二种是采用WMI(Windows Management Instrumentation)对象来完成，下面是具体源代码。

第一种方法：VBA中通过Wscript.Shell对象Ping主机是否连接

Option Explicit
'================================
' VBA中通过Wscript.Shell对象Ping主机是否连接
'
' 
'================================
Function sPing(sHost As String) As String
 
    Dim oFSO As Object, oShell As Object, oTempFile As Object
    Dim sLine As String, sFilename As String
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oShell = CreateObject("Wscript.Shell")
    
    sFilename = oFSO.GetTempName
    oShell.Run "cmd /c ping " & sHost & " >" & sFilename, 0, True
    Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
 
    Do While oTempFile.AtEndOfStream <> True
        sLine = oTempFile.Readline
        sPing = sPing & Trim(sLine)
    Loop
    oTempFile.Close
    oFSO.DeleteFile (sFilename)
End Function
 
Sub TestPing()
    MsgBox sPing("www.CnHUP.com")
End Sub 

第二种方法：VBA中通过WMI对象Ping主机是否连接

Option Explicit
'================================
' VBA中通过WMI对象Ping主机是否连接
'
' 
'================================
Function sPing(sHost) 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) & Chr(10)
            sPing = sPing & "Time (ms) = " & vbTab & oRetStatus.ResponseTime & Chr(10)
            sPing = sPing & "TTL (s) = " & vbTab & vbTab & oRetStatus.ResponseTimeToLive
        End If
    Next
End Function
 
Sub TestPing()
    MsgBox sPing("www.CnHUP.com")
End Sub

上面两个对象在VBA中可以简单地实现许多高级的功能，这里使用它们Ping主机是否连接也仅是一砖而已，玉等着大家去捡呢。