CODEWITHSUNDEEP
vbaexcel
skatun
skatun

Reputation: 877

Timeout on http request in vba

It has happened that the server hangs or that there is something wrong with the http request I am sending. So I was wondering if I could add a timeout code to my function to avoid my macro from crashing, but rather return an empty array and then I can use that to display an error message to the user...

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

Upvotes: 0

Views: 3264

Answers (1)

user6698332
user6698332

Reputation: 427

Before send http query I try to ping server and if I recieve actual responce value pass it to 

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

.

Upvotes: 1

Related Questions