Question

我通过VPN拥有美国，印度和远程用户的集合。我正在使用无DSN方法链接到Access DB App中的远程表。

我需要一种有效的方法来确定用户选择的IP是否可访问（称为“myIP”）。

我当前的方法是PINGS myIP，但会打开一个讨厌的CMD窗口并需要几秒钟来解决状态。

SystemReachable (myIP)

If InStr(myStatus, "Reply") > 0 Then
    ' MsgBox "IP is Confirmed Reachable"
Else
    MsgBox "[" & myIP & "] is not Reachable" & vbCrLf & vbCrLf & Confirm your selected location, or VPN is active."
    Exit Sub
End If

''''''''''''''''''''''''''''

Function SystemReachable(ByVal ComputerName As String)
Dim oShell, oExec As Variant
Dim strText, strCmd As String

strText = ""
strCmd = "ping -n 3 -w 1000 " & ComputerName

Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec(strCmd)

Do While Not oExec.StdOut.AtEndOfStream
    strText = oExec.StdOut.ReadLine()
    If InStr(strText, "Reply") > 0 Then
        myStatus = strText
        Exit Do
    Else
        myStatus = ""
    End If
Loop

End Function

是否有更好/更快的方法来确定“myIP”的状态/可达性？

谢谢！

Answer 1

找到了一种非常可行且无声的方法：

Dim strCommand as string
Dim strPing As String

strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 -w 500 " & myIP & " | " & "%SystemRoot%\system32\find.exe /i " & Chr(34) & "TTL=" & Chr(34)
strPing = fShellRun(strCommand)

If strPing = "" Then
    MsgBox "Not Connected"
Else
    MsgBox "Connected!"
End If

'''''''''''''''''''''''''''

Function fShellRun(sCommandStringToExecute)

' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.

' "myIP" is a user-selected global variable

Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr

Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
    On Error Resume Next
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
    iErr = Err.Number

    On Error GoTo 0
    If iErr <> 0 Then
        fShellRun = ""
        Exit Function
    End If

    On Error GoTo err_skip
    fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1).ReadAll
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

Exit Function

err_skip:
    fShellRun = ""
    oFileSystemObject.DeleteFile sShellRndTmpFile, True


End Function

Answer 2

使用临时文件执行此操作似乎不是一个好的解决方案，尤其是在使用SSD时。

ShellObject.Run传递时TRUE作为第三参数，则返回该命令返回值。

有关的“ping”，它被设置为0时，主机是可到达的，并且设置为他人，如果它不是可到达的或任何错误发生的情况。因此，您可以使用下面的方法快速确定目的地是否可达：

    Dim strCommand
    Dim iRet

    strCommand = "%SystemRoot%\system32\ping.exe -n 1 -l 1 -w 500 " & myIP
    iRet = fShellRun(strCommand)

    If iRet <> 0 Then
        MsgBox "Not Connected"
    Else
        MsgBox "Connected!"
    End If

    Function fShellRun(sCommandStringToExecute)

        ' This function will accept a string as a DOS command to execute.
        ' It will then execute the command in a shell, and returns the command 
        ' return code to the caller. 

        ' "myIP" is a user-selected global variable

        Dim oShellObject

        Set oShellObject = CreateObject("Wscript.Shell")

        On Error Resume Next
        fShellRun = oShellObject.Run(sCommandStringToExecute, 0, TRUE)

    End Function

Answer 3

基于 Steven Ding 的解决方案，我缩短为 1-liner（因为我只是喜欢重载的短函数）：

Function PingOk(Ip As String) As Boolean
  PingOk = (0 = CreateObject("Wscript.Shell").Run("%SystemRoot%\system32\ping.exe -n 1 -l 1 -w 5000 " & Ip, 0, True))
End Function

VBA - 确定IP是否可达

3 个答案: