互联网连接检查 - 访问VBA

时间:2017-01-31 10:20:54

标签: vba ms-access internet-connection

所以,我已经花了比预期更长的时间来首先发现这个功能,虽然它非常适合离线(缺乏基于wifi或以太网的连接)但是在确定是否连接时非常模糊到互联网。 https://msdn.microsoft.com/en-us/library/windows/desktop/aa384702(v=vs.85).aspx

示例案例是,如果您在任何咖啡店或酒店都有登录屏幕,或者更糟糕的是如果连接到没有互联网连接的无线网络,它会返回在线结果吗?!

现在,我所希望的功能是给出一个非常可靠的3个案例的回报,绝对在线,绝对离线,诊断网络上的问题(如果通过以太网连接或没有互联网连接的wifi连接,包括但不限于断开连接以太网交换机,万兆以太网端口断开,酒店wifi,公共wifi,登录等)

由于"完全脱机而引发的2个已知错误代码"没有插入以太网电缆,或任何无线连接活动;第二种是在任何网络上但没有实时网络连接。

现在问题

我有完整功能的代码,但是如上面提到的情况3中的大型访问数据库,表格或任何运行的功能冻结,从简单地拖动打印预览屏幕到打字,它将冻结。

这对许多后台功能起作用是不可行的,例如搜索或其他计时器,当最终用户尝试使用不断(每10秒钟)挂起的内容时,它会导致问题。现在我已经想到了将计时器更改为每5分钟一次的方法,但是这会在这里击败对象,因为我试图不断向用户显示特别是在他们不再连接的间歇性互联网连接区域内。

我已经搜索了修改超时期限,但这模糊地解决了我的问题,在广泛的测试中平均最多可以减少1秒。目前离开我大约4-6秒的时间#34; Access没有响应"

要明确的是,使用我的请求响应方法在绝对在线(从网页获取响应)和离线(即时超时)两种简单情况下都能正常工作。

我怎样才能根除停止访问静止的.get,即使在vba中你不能向上/向下滚动或尝试修改任何东西,除非超出计时器的时间(10秒)所以需要4-6秒处理"诊断" case,将文本输出为表单上的小方框。

Public Function ConnectivityCheck(urlzzz) As Long

On Error GoTo err_handler:
Dim Resolve, Connect, Send, Receive As Integer
Dim RequestResponse As XMLHTTP60
Dim K As Integer
Dim Parameter1 As String
Dim Doc As DOMDocument60
Set RequestResponse = New XMLHTTP60

Set Doc = New DOMDocument60
Set RequestResponse = CreateObject("Msxml2.ServerXMLHTTP.6.0")

    Resolve = 200     ' In Milliseconds, 4 Stages to a Request.statement each individually attuned timing before
    Connect = 350    '"timing" out/cancelling the request.
    Send = 350
    Receive = 350     'waiting time to receive data from server
    RequestResponse.setTimeouts Resolve, Connect, Send, Receive

With RequestResponse
    .Open "GET", urlzzz, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send
    Doc.LoadXML .responseText
End With
Doc.LoadXML Doc.Text

If InStr(RequestResponse.responseText, "example") Then
    K = 1
    ConnectivityCheck = K
    Debug.Print RequestResponse.responseText

End If


Exit Function
err_handler:
    ConnectivityCheck = err.Number
    Debug.Print ConnectivityCheck
    If err.Number = -2147012894 Then
        Debug.Print "No internet connection" ' connected to some sort of network but no live web connection
    ElseIf err.Number = -2147012889 Then
    Debug.Print "Offline" 'simply unplugged or not connected to any wireless network
    End If
End Function

Public Sub testerrrr()
Dim urlzzz As String
urlzzz = "http://www.webservicex.net/stockquote.asmx/GetQuote?symbol=example"
ConnectivityCheck (urlzzz)

End Sub

我感谢任何提示或指示,甚至是我可能忽略的基本内容。

感谢。

0 个答案:

没有答案