vba 检查活动的互联网连接

Check for active internet connection

提问by user51498

Wrote a small app that accesses a bunch of search websites and puts the results in a word document, which gets run a few hundred times a day.

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

It saves individual search results in a number of local folders so the next time those words are searched, it grabs them locally instead of loading the website again.

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

This works fine - even though it's not quick. People are impressed because until a few weeks ago they did this manually by literally loading up six different search websites, searching, and then copying and pasting the results in a word document.

这很好用 - 即使它不快。人们印象深刻，因为直到几周前，他们还是通过手动加载六个不同的搜索网站，进行搜索，然后将结果复制并粘贴到 Word 文档中。

However, our Office's internet is unreliable, and has been down the last half a day. This has meant about 400 bad searches have been saved in the local folders, and inserted into the final documents.

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

When a person was searching they could tell if the internet was broken and they would do their searches later. Obviously, though, this app can't tell, and because I'm not using APIs or anything, and because I am limited to using the VBA environment (I'm not even allowed MZ tools), I need to find some way to check that the internet is working before continuing with the program flow, without relying on too many references, and preferably without screenscraping for the phrase "404 Page Not Found".

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

I'm not very familiar with VB, and VBA is ruining me in so many ways, so there's probably some easy way to do this, which is why I'm asking here.

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

Appreciate any help.

感谢任何帮助。

采纳答案by shahkalpesh

You could use MSXML library & use XMLHttpRequest class to check for things

您可以使用 MSXML 库并使用 XMLHttpRequest 类来检查事物

e.g.

例如

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

The status will give you HTTP Status code of what happened to the request. You might have to do some more checks, depending on your scenario.

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

Hope that helps.

希望有帮助。

回答by Tomalak

Obviously, your problem has many levels. You should start by defining "connected to the internet", and go on with developing fallback strategies that include not writing invalid files on failure.

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

As for the "am I connected" question, you can try tapping into the Win32 API:

至于“我是否已连接”的问题，您可以尝试使用 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

Though depending on your network setup (proxy/NAT/firewall restrictions etc.), Windows might have a different opinion about this than you.

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

Trying to GET the pages you are interested in, checking on the return status in the HTTP headers (gateway timeout, 404, whatever you expect to happen when it "doen't work) might also be a way to go.

尝试获取您感兴趣的页面，检查 HTTP 标头中的返回状态（网关超时，404，无论您希望在“不起作用时”发生什么）也可能是一种方法。

回答by Daniel Isoje

Use the following code to check for internet connection first anable XML v6.0 in your references

使用以下代码在您的参考资料中首先检查互联网连接是否可用 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

回答by barrowc

Building on shakalpesh's answer and the comments to it, there are (at least) two ways to get the web page into Word without parsing the XML returned by the XMLHTTP60 object.

基于 shakalpesh 的回答和对它的评论，有（至少）两种方法可以在不解析 XMLHTTP60 对象返回的 XML 的情况下将网页导入 Word。

(NB the HTTP status code of 200 indicates that "the request has succeeded" - see here)

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

• write the XMLHTTP60.ResponseTextout to a text file and then call Documents.Openon that text file

• 将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"

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"

This has the disadvantage that some linked elements may be lost and you'll get a message box when the file opens

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

• check the URL status with the XMLHTTP60 object and then use Documents.Opento open the URL as before:

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

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

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

There is a slight chance that the XMLHTTP60 request could succeed and the Documents.Openone fail (or vice versa). Hopefully this should be a fairly uncommon event though

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

回答by Jason Baker

Unfortunately, this is a bit of a difficult question to answer for a couple of reasons:

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

1. How do you define a non-working internet connection? Do you check for a valid IP address? Do you ping out? How do you know that you have permissions to check these things? How do you know that the computer's firewall/antivirus isn't causing wonky behavior?
2. Once you've established that the connection is working, what do you do if the connection drops mid-operation?

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

There are probably ways to do what you want to do, but a lot of "devil's in the details" type things tend to pop up. Do you have any way to check that the saved search is valid? If so, that would probably be the best way to do this.

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

回答by technoman23

I found most answers here and elsewhere confusing or incomplete, so here is how to do it for idiots like me:

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

'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

回答by David Naylor

This is what I use. I prefer it because it doesn't require any external references or DLLs.

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