检查是否有活动的互联网连接

Question

编写了一个小应用程序，可以访问大量搜索网站并将结果放入 Word 文档中，该应用程序每天运行数百次。

它将各个搜索结果保存在多个本地文件夹中，以便下次搜索这些单词时，它会在本地获取它们，而不是再次加载网站。

这工作得很好——尽管它并不快。 人们印象深刻，因为直到几周前，他们通过手动加载六个不同的搜索网站，进行搜索，然后将结果复制并粘贴到 Word 文档中来手动完成此操作。

然而我们办公室的网络不太稳定，最近半天就断线了。 这意味着大约 400 个错误搜索已保存在本地文件夹中，并插入到最终文档中。

当一个人进行搜索时，他们可以判断互联网是否中断，然后他们就会进行搜索。 但显然，这个应用程序无法判断，并且因为我没有使用 API 或任何东西，并且因为我仅限于使用 VBA 环境（我什至不允许使用 MZ 工具），所以我需要找到某种方法来在继续程序流程之前检查互联网是否正常工作，不要依赖太多参考，最好不要对短语“404 Page Not Found”进行屏幕抓取。

我对 VB 不太熟悉，而且 VBA 在很多方面都在毁掉我，所以可能有一些简单的方法可以做到这一点，这就是我在这里问的原因。

感谢任何帮助。

Answer 1

不幸的是，由于以下几个原因，这是一个有点难以回答的问题：

1. 如何定义不工作的互联网连接？ 您检查 IP 地址是否有效？ 你能ping通吗？ 你怎么知道你有权限检查这些东西？ 您如何知道计算机的防火墙/防病毒软件不会导致异常行为？
2. 一旦确定连接正常工作，如果连接在操作过程中断开，您该怎么办？

可能有很多方法可以做你想做的事情，但是很多“细节决定成败”类型的事情往往会出现。 您有什么方法可以检查保存的搜索是否有效？ 如果是这样，这可能是最好的方法。

Answer 2

根据 shakalpesh 的回答及其评论，（至少）有两种方法可以将网页放入 Word，而无需解析 XMLHTTP60 对象返回的 XML。

（注意，HTTP 状态代码 200 表示“请求已成功” - 请参阅 此处）

• 将 XMLHTTP60.ResponseText 写入文本文件，然后对该文本文件调用 Documents.Open

如果 (xhr.Status = 200) 那么 
      hOutFile = 自由文件 
      打开“C:\foo.html”以输出为 #hOutFile 
      打印 #hOutFile, xhr.responseText 
      关闭#hOutFile 
  万一 

  // ... 

  文档.打开“C:\foo.html” 
  

这样做的缺点是某些链接的元素可能会丢失，并且在文件打开时您会收到一个消息框，

• 使用 XMLHTTP60 对象检查 URL 状态，然后像以前一样使用 Documents.Open 打开 URL ：

如果 (xhr.Status = 200) 那么 
      文档.打开“http://foo.bar.com/index.html” 
  万一 
  

XMLHTTP60 请求成功而 Documents.Open 请求失败（反之亦然）的可能性很小。 希望这应该是一个相当不常见的事件

Answer 3

我发现这里和其他地方的大多数答案令人困惑或不完整，所以这里是像我这样的傻瓜如何做的：

'paste this code in at the top of your module (it will not work elsewhere)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20

'paste this code in anywhere
Function IsInternetConnected() As Boolean
    Dim L As Long
    Dim R As Long
    R = InternetGetConnectedState(L, 0&)
    If R = 0 Then
        IsInternetConnected = False
    Else
        If R <= 4 Then IsInternetConnected = True Else IsInternetConnected = False
    
    End If
End Function

'your main function/calling function would look something like this
Private Sub btnInternetFunction_Click()
    If IsInternetConnected() = True Then
        MsgBox ("You are connected to the Internet")
        'code to execute Internet-required function here
    Else
        MsgBox ("You are not connected to the Internet or there is an issue with your Internet connection.")
    End If
End Sub

Answer 4

这就是我用的。 我更喜欢它，因为它不需要任何外部引用或 DLL。

Public Function IsConnected()
    Dim objFS As Object
    Dim objShell As Object
    Dim objTempFile As Object
    Dim strLine As String
    Dim strFileName As String
    Dim strHostAddress As String
    Dim strTempFolder As String

    strTempFolder = "C:\PingTemp"
    strHostAddress = "8.8.8.8"
    IsConnected = True ' Assume success
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Wscript.Shell")

    If Dir(strTempFolder, vbDirectory) = "" Then
      MkDir strTempFolder
    End If

    strFileName = strTempFolder & "\" & objFS.GetTempName
    If Dir(strFileName) <> "" Then
      objFS.DeleteFile (strFileName)
    End If

    objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
    Set objTempFile = objFS.OpenTextFile(strFileName, 1)
    Do While objTempFile.AtEndOfStream <> True
        strLine = objTempFile.Readline
        If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
            IsConnected = False
        End If
    Loop
    objTempFile.Close
    objFS.DeleteFile (strFileName)
    objFS.DeleteFolder (strTempFolder)

    ' Remove this after testing.  Function will return True or False
    MsgBox IsConnected
End Function

Answer 5

我遇到了同样的问题，经过大量谷歌搜索后，我意识到有一种更简单的方法可以做到这一点......它要求用户启用 Microsoft Internet Explorer 控件库，但仅此而已。 这个想法是，您的代码在获取网页文档（HTML）后导航到网站（在本例中为谷歌）。 在搜索框中输入一个值。

Sub Test1()
On Error GoTo no_internet 'Error handler when no internet
Dim IE As New SHDocVw.InternetExplorer

IE.Visible = False 'Not to show the browser when it runs
IE.navigate "www.google.com" 'navigates to google

Do While IE.ReadyState <> READYSTATE_COMPLETE 'loops until it is ready
Loop

'Here It gets the element "q" from the form "f" of the HTML document of the webpage, which is the search box in google.com
'If there is connection, it will run, quit and then go to the msgbox.
'If there is no connection, there will be an error and it will go to the error handler "no_internet" that is declared on top of the code
IE.document.forms("f").elements("q").Value = "test"
IE.Quit

MsgBox "Internet Connection: YES"
Exit Sub
no_internet:
IE.Quit
MsgBox "Internet Connection: NO" ' and here it will know that there is no connection.
End Sub

Answer 6

显然，你的问题有很多层次。 您应该从定义“连接到互联网”开始，然后继续制定后备策略，包括在失败时不写入无效文件。

至于“我是否已连接”问题，您可以尝试利用 Win32 API：

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long ) As Long

Public Function GetInternetConnectedState() As Boolean
  GetInternetConnectedState = InternetGetConnectedState(0&,0&)
End Function

尽管根据您的网络设置（代理/NAT/防火墙限制等），Windows 可能对此有与您不同的看法。

尝试获取您感兴趣的页面，检查 HTTP 标头中的返回状态（网关超时、404、当它“不起作用”时您期望发生的任何情况）也可能是一种方法。

Answer 7

您可以使用 MSXML 库 & 使用 XMLHttpRequest 类来检查一些事情

，例如

On Error Resume Next
Dim request As MSXML2.XMLHTTP60
request.Open "http://www.google.com"
request.Send
Msgbox request.Status

状态将为您提供请求发生情况的 HTTP 状态代码。
根据您的情况，您可能需要进行更多检查。

希望有帮助。

Answer 8

使用以下代码检查互联网连接
参考文献中第一个可用的 XML v6.0

Function checkInternetConnection() As Integer
'code to check for internet connection
'by Daniel Isoje
On Error Resume Next
 checkInternetConnection = False
 Dim objSvrHTTP As ServerXMLHTTP
 Dim varProjectID, varCatID, strT As String
 Set objSvrHTTP = New ServerXMLHTTP
 objSvrHTTP.Open "GET", "http://www.google.com"
 objSvrHTTP.setRequestHeader "Accept", "application/xml"
 objSvrHTTP.setRequestHeader "Content-Type", "application/xml"
 objSvrHTTP.Send strT
 If err = 0 Then
 checkInternetConnection = True
 Else
  MsgBox "Internet connection not estableshed: " & err.Description & "", 64, "Additt !"
 End If
End Function