Fatal编程技术网
  • vba/
  • Vba 检查活动的internet连接

Vba 检查活动的internet连接

vba networking ms-office

Vba 检查活动的internet连接,vba,networking,ms-office,Vba,Networking,Ms Office,编写了一个小应用程序，可以访问多个搜索网站，并将结果放入word文档中，每天运行数百次 它将单个搜索结果保存在多个本地文件夹中，以便下次搜索这些单词时，它将在本地捕获它们，而不是再次加载网站 这很好用——尽管不是很快。人们对此印象深刻，因为直到几周前，他们还通过手动方式加载六个不同的搜索网站，搜索，然后将结果复制并粘贴到word文档中 然而，我们办公室的互联网是不可靠的，并且在过去的半天里一直处于瘫痪状态。这意味着大约400个错误的搜索已保存在本地文件夹中，并插入到最终文档中 当一个人在搜索时，

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

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

这很好用——尽管不是很快。人们对此印象深刻，因为直到几周前，他们还通过手动方式加载六个不同的搜索网站，搜索，然后将结果复制并粘贴到word文档中

然而，我们办公室的互联网是不可靠的，并且在过去的半天里一直处于瘫痪状态。这意味着大约400个错误的搜索已保存在本地文件夹中，并插入到最终文档中

当一个人在搜索时，他们可以判断网络是否断了，他们会在以后进行搜索。很明显，这个应用程序不能告诉我，因为我没有使用API或其他任何东西，而且因为我仅限于使用VBA环境（我甚至不允许使用MZ工具），所以我需要找到某种方法来检查互联网是否正常工作，然后再继续程序流，而不需要依赖太多的引用，最好不用截屏“404页未找到”

我对VB不是很熟悉，VBA在很多方面都毁了我，所以可能有一些简单的方法可以做到这一点，这就是为什么我在这里问这个问题

感谢您的帮助。

不幸的是，这是一个有点难回答的问题，原因如下：

  • 如何定义不工作的internet连接？您是否检查有效的IP地址？你出去玩吗？你怎么知道你有权限检查这些东西？您如何知道计算机的防火墙/防病毒软件没有引起不稳定的行为
  • 一旦您确定连接正在工作，如果连接在运行中中断，您该怎么办
    • 可能有很多方法可以做你想做的事情，但是很多“细节中的魔鬼”类型的事情往往会突然出现。您是否有办法检查保存的搜索是否有效？如果是这样，那可能是最好的方法。

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

    至于“我是否已连接”问题，您可以尝试使用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，当它“不工作”时您期望发生的任何情况）也可能是一种方法。

    您可以使用MSXML库和XMLHttpRequest类来检查

    e、 g

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

    希望能有所帮助。

    基于shakalpesh的答案和对它的评论，有（至少）两种方法可以将网页转换为Word，而无需解析XMLHTTP60对象返回的XML

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

    • 将
      XMLHTTP60.ResponseText
      写入文本文件，然后调用
      Documents。打开该文本文件
    这样做的缺点是某些链接元素可能会丢失，并且在文件打开时会出现一个消息框

    • 检查XMLHTTP60对象的URL状态，然后使用
      文档。打开
      与前面一样打开URL：
    XMLHTTP60请求成功的可能性很小，
    文档打开失败一次（反之亦然）。希望这是一个相当罕见的事件，尽管使用以下代码检查internet连接
在您的引用中，首先是一个可编辑的XMLV6.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

    

    我发现这里和其他地方的大多数答案都令人困惑或不完整，所以下面是像我这样的白痴该怎么做：
    

    '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

    

    '将此代码粘贴到模块顶部（在其他地方不起作用）
私有声明函数InternetGetConnectedState库“wininet.dll”（ByRef dwflags为Long，ByVal dwReserved为Long）为Long
专用常量INTERNET\u连接\u调制解调器长度=&H1
专用常量INTERNET\u连接\u LAN长度=&H2
专用常量INTERNET\u连接\u代理长度=&H4
Private Const INTERNET\u连接\u脱机（只要=&H20）
'将此代码粘贴到任意位置
函数IsInternetConnected（）为布尔值
我和你一样长
变暗，变长
R=InternetGetConnectedState（L，0&）
如果R=0，则
IsInternetConnected=False
其他的

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

    

    公共功能已连接（）
作为对象的Dim objFS
Dim objShell作为对象
Dim objTempFile作为对象
暗斯特林作为弦
将strFileName设置为字符串
作为字符串的Dim strHostAddress
将strTempFolder设置为字符串
strTempFolder=“C:\PingTemp”
strHostAddress=“8.8.8.8”
IsConnected=True“假设成功
设置objFS=CreateObject（“Scripting.FileSystemObject”）
设置objShell=CreateObject（“Wscript.Shell”）
如果Dir（strTempFolder，vbDirectory）=“”，则
MkDir strTempFolder
如果结束
strFileName=strTempFolder&“\”&objFS.GetTempName
如果Dir（strFileName）“，则
objFS.DeleteFile（strFileName）
如果结束
objShell.Run“cmd/cping”&strHostAddress&“-n1-w1>”&strFileName，0，True
设置objTempFile=objFS.OpenTextFile（strFileName，1）
当objTempFile.AtEndOfStream为True时执行此操作
strLine=objTempFile.Readline
如果InStr（1，UCase（strLine），“请求超时”。）>0或InStr（1，UCase（strLine），“找不到主机”）>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

    

    '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

    

    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

    

    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