vba中http请求超时

时间:2016-08-10 13:33:06

标签: vba excel-vba excel

发生了服务器挂起或我发送的http请求有问题。所以我想知道我是否可以为我的函数添加超时代码以避免我的宏崩溃,而是返回一个空数组然后我可以使用它来向用户显示错误消息......

Function helpRequest(stringQuery As String) As String()
    Dim objRequest As MSXML2.XMLHTTP60
    Dim O As MSHTML.HTMLDocument
    Dim i As Integer

    Dim asCells() As String

    Dim contentType As String
    Dim temp As String

    If UCase(Right(stringQuery, 4)) = ".ASP" Then
        stringQuery = stringQuery & "?Cache=" & CStr(Int(200000000000000# * Rnd))
    Else
        stringQuery = stringQuery & "&Cache=" & CStr(Int(200000000000000# * Rnd))
    End If
    contentType = "application/x-www-form-urlencoded; charset=UTF-8"

    Set O = New HTMLDocument
    Set objRequest = CreateObject("MSXML2.XMLHTTP.6.0")

    With objRequest
        .Open "GET", stringQuery, False
        .send

    End With

    O.body.innerHTML = objRequest.responseText

1 个答案:

答案 0 :(得分:1)

在发送http查询之前,我尝试ping服务器,如果我收到实际的响应值,则将其传递给

Dim xht As New ServerXMLHTTP
    lPng = fn_Ping(sHst)
    Select Case (lPng < 0)
        Case True:  lTmo = 500: Debug.Print fn_Err(-lPng)
        Case False: lTmo = lPng + 100 'Debug.Print "Ping to " & sHost & " = " & lPng
    End Select
    With xht
        Call .setTimeouts(lTmo, lTmo, lTmo, lTmo) ' Def (10, 10, 10, 10)?
        Call .Open(sCmd, sURL, False)  ' True ' async
        lSta = .Status
        Select Case lSta
            Case 200'CheckRemoteURL = True
                ' do something'
            Case 202, 302
                Stop
            Case 404
                Stop
            Case Else
                'CheckRemoteURL = False
                Debug.Print .getAllResponseHeaders
                Stop
        End Select
    End With