Question

写了一个访问大量搜索网站的小应用程序，并将结果放入word文档中，每天运行几百次。

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

这很好 - 即使它不快。人们印象深刻，因为直到几个星期前他们通过装载六个不同的搜索网站，搜索，然后将结果复制并粘贴到word文档中手动完成。

然而，我们办公室的互联网不可靠，并且已经过了半天。这意味着在本地文件夹中保存了大约400个错误搜索，并将其插入到最终文档中。

当一个人正在搜索时，他们可以判断互联网是否已损坏，他们会在以后进行搜索。显然，这个应用程序无法分辨，因为我没有使用API或任何东西，因为我只能使用VBA环境（我甚至不允许使用MZ工具），我需要找到一些方法来在继续执行程序流程之前检查互联网是否正常工作，而不依赖于过多的引用，最好不要使用屏幕抓取短语“404 Page Not Found”。

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

感谢任何帮助。

Answer 1

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

至于“我连接”问题，您可以尝试使用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，无论您在“不起作用”时发生什么），也可能是一种方法。< / p>

Answer 2

您可以使用MSXML库＆amp;使用XMLHttpRequest类来检查事物

e.g。

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

状态将为您提供请求发生的HTTP状态代码。您可能需要进行更多检查，具体取决于您的方案。

希望有所帮助。

Answer 3

使用以下代码检查互联网连接您的参考文献中首先提供了可用的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

Answer 4

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

如何定义不可用的互联网连接？你检查有效的IP地址吗？你突出了吗？你怎么知道你有权检查这些东西？你怎么知道计算机的防火墙/防病毒软件没有导致不稳定的行为？
一旦确定连接正常，如果连接中途运行，你会怎么做？

可能有办法做你想做的事情，但很多“细节中的魔鬼”类型的东西往往会弹出。您有什么方法可以检查保存的搜索是否有效？如果是这样，那可能是最好的方法。

Answer 5

在shakalpesh的回答和对它的评论的基础上，有（至少）两种方法将网页导入Word而不解析XMLHTTP60对象返回的XML。

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

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

If (xhr.Status = 200) Then
    hOutFile = FreeFile
    Open "C:\foo.html" For Output As #hOutFile
    Print #hOutFile, xhr.responseText
    Close #hOutFile
End If

// ...

Documents.Open "C:\foo.html"

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

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

If (xhr.Status = 200) Then
    Documents.Open "http://foo.bar.com/index.html"
End If

XMLHTTP60请求有可能成功，Documents.Open一个失败（反之亦然）。希望这应该是一个相当不寻常的事件，但

Answer 6

在这里和其他地方，我发现大多数答案令人困惑或不完整，所以这是针对像我这样的白痴的解决方法：

'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 7

这就是我用的。我更喜欢它，因为它不需要任何外部引用或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 8

我遇到了同样的问题，在谷歌搜索了很多之后，我意识到有一种更简单的方法来做到这一点......它需要用户启用 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

检查有效的互联网连接

8 个答案: