VBA - 确定 IP 是否可达
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19146126/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA - Determine if IP is Reachable
提问by Mark Pelletier
I have a collection of users US, India, and Remote via VPN. I am using a DSN-less approach to link to remote tables in my Access DB App.
我通过 VPN 收集了美国、印度和远程用户。我正在使用无 DSN 的方法链接到我的 Access DB 应用程序中的远程表。
I need an efficient method to determine if the user-selected IP is reachable (called "myIP").
我需要一种有效的方法来确定用户选择的 IP 是否可达（称为“myIP”）。
My current approach PINGS myIP, but opens a pesky CMD window and takes several seconds to resolve the status.
我目前的方法 ping 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
Is there a better/faster way to determine the status/reachability of "myIP"?
有没有更好/更快的方法来确定“myIP”的状态/可达性？
Thanks!
谢谢！
回答by Mark Pelletier
Found a very workable and silent approach:
找到了一个非常可行且无声的方法：
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
回答by Steven Ding
Doing so with a temp file doesn't seem a good solution, especially when SSD is used.
使用临时文件这样做似乎不是一个好的解决方案，尤其是在使用 SSD 时。
ShellObject.Run when you pass TRUE as the 3rd parameter, it returns the command return value.
ShellObject.Run 当您将 TRUE 作为第三个参数传递时，它会返回命令返回值。
For "ping", it's set to 0 when the host is reachable, and set to others if it's not reachable or any error happens. So you can use below to quickly decide whether the destination is reachable:
对于“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
