WinHttpRequest in VBA only works if preceded by a Browser call

Question

The following URL returns an XML with USD exchange rate:

http://www.boi.org.il/currency.xml?curr=01

I need to call and extract (by parsing the result) the returned rate from Excel VBA.

When called in VBA after invoked manually in browser - it works fine. However, after a certain amount of time, it is not working anymore from VBA, unless called manually again in the browser first. Instead, it returns this string as a result:

<html><body><script>document.cookie='ddddddd=978a2f9dddddddd_978a2f9d; path=/';window.location.href=window.location.href;</script></body></html>

The VBA I'm using to call is this:

Function GetExchangeRate(ByVal curr As Integer, Optional ByVal exDate As Date = 0) As Single

    Dim strCurrCode As String
    Dim strExDate As String
    Dim strDateParamURL As String
    Dim intStartPos As Integer
    Dim intEndPos As Integer
    Dim sngRate As Single

    sngRate = -1

    On Error GoTo FailedCurr

    strDateParamURL = ""

    strCurrCode = Format(curr, "00")
    If (exDate > 0) Then
        strExDate = Format(exDate, "yyyymmdd")
        strDateParamURL = "&rdate=" & strExDate
    End If


    Dim result As String
    Dim myURL As String
    Dim winHttpReq As Object

    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    myURL = "http://www.boi.org.il/currency.xml"
    myURL = myURL & "?curr=" & strCurrCode & strDateParamURL

    winHttpReq.Open "GET", myURL, False
    winHttpReq.Send

    result = winHttpReq.responseText

    intStartPos = InStr(1, result, "<RATE>") + 6
    intEndPos = InStr(1, result, "</RATE>") - 1

    If (intEndPos > 10) Then
        sngRate = CSng(Mid(result, intStartPos, intEndPos - intStartPos + 1))
    End If
CloseSub:
    GetExchangeRate = sngRate
    Exit Function
FailedCurr:
    GoTo CloseSub
End Function

EDIT: I tried this using the MSXML2 object - exactly the same behavior! works only after a browser activation. This is the XML code:

Function GetExchangeRateXML(ByVal curr As Integer, Optional ByVal exDate As Date = 0) As Single

    Dim strDateParamURL As String
    Dim intStartPos As Integer
    Dim intEndPos As Integer
    Dim sngRate As Single
    Dim myURL As String

    sngRate = -1

    ''On Error GoTo FailedCurr

    If (curr = 0) Then
        sngRate = 1
        GoTo CloseSub
    End If

    strDateParamURL = ""

    strCurrCode = Format(curr, "00")
    If (exDate > 0) Then
        strExDate = Format(exDate, "yyyymmdd")
        strDateParamURL = "&rdate=" & strExDate
    End If


    myURL = "http://www.boi.org.il/currency.xml"
    myURL = myURL & "?curr=" & strCurrCode & strDateParamURL

    Dim oXMLFile As Object
    Dim RateNode As Object

    Set oXMLFile = CreateObject("MSXML2.DOMDocument")
    oXMLFile.async = False
    oXMLFile.validateOnParse = False
    oXMLFile.Load (myURL)

    Set RateNode = oXMLFile.SelectNodes("//CURRENCIES/CURRENCY[0]/RATE")


    Debug.Print (RateNode(0).Text)

CloseSub:
    GetExchangeRateXML = CSng(RateNode(0).Text)
    Set RateNode = Nothing
    Set oXMLFile = Nothing

    Exit Function
FailedCurr:
    GoTo CloseSub
End Function

Any ideas why this is not working initially from the VBA function?

I recreated this error and it did happen to me too, I was going to try it using MSXML2.ServerXMLHTTP60 where you can set request headers but annoyingly now I don't know how to revert back to the "timedout" scenario so I can test it! How long does it normally take before it doesn't work any more? — jamheadart, Jul 30 '17 at 19:28
Definitely got something to do with their weird cookie, doing a network watch while visiting the site to see the "ddddddd=978a2f9dddddddd_978a2f9d" maybe you could parse that from the first visit then setRequestHeader with the cookie and resend? — jamheadart, Jul 30 '17 at 19:31
Probably - see my edit about MSXML object - same behavior. Can you show me what you mean by setRequestHeader with the cookie? — Mor Sagmon, Jul 30 '17 at 19:35
I will create an answer below but I'm not sure it'll work, it's just the first thing I'd try! — jamheadart, Jul 30 '17 at 19:36

score 5 · Accepted Answer · answered Jul 31 '17 at 19:39

leveraging jamheadart's approach to capture the cookie in the initializing call, I modified the function to allow for the cookie to be captured and re-sent via the headers in subsequent http requests (I allow up to 6 tries here, but it usually settles after two).

The working code is therefore:

Function GetExchangeRate(ByVal curr As Integer, Optional ByVal exDate As Date = 0) As Single
'Finds the exchange rate for a given requested date and requested currency.
'If date is omitted, returns the most recent exchange rate available (web service behavior by design)
'If curr = 0 then return  1 = for New Shekel
'The call to the BOI service first sends a cookie, and only subsequent calls return the XML structure with the result data.
'The cookie has a timeout of several minutes. That's why, we challenge a couple of calls until the cookie string is not returned - then we extract the data from result.

    Dim strCurrCode As String
    Dim strExDate As String
    Dim strDateParamURL As String
    Dim intStartPos As Integer
    Dim intEndPos As Integer
    Dim sngRate As Single

    sngRate = -1

    On Error GoTo FailedCurr

    If (curr = 0) Then
        sngRate = 1
        GoTo CloseSub
    End If

    strDateParamURL = ""

    strCurrCode = Format(curr, "00")
    If (exDate > 0) Then
        strExDate = Format(exDate, "yyyymmdd")
        strDateParamURL = "&rdate=" & strExDate
    End If


    Dim result As String
    Dim myURL As String
    Dim winHttpReq As Object
    Dim i As Integer
    Dim strCookie As String
    Dim intTries As Integer

    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    myURL = "http://www.boi.org.il/currency.xml"
    myURL = myURL & "?curr=" & strCurrCode & strDateParamURL

    With winHttpReq

        .Open "GET", myURL, False
        .Send
        .waitForResponse 4000
        result = .responseText

        'Is cookie received?
        intTries = 1
        Do Until ((InStr(1, result, "cookie") = 0) Or (intTries >= MAX_HTTP_COOKIE_TRIES))

            intStartPos = InStr(1, result, "cookie") + 8
            intEndPos = InStr(1, result, ";") - 1
            strCookie = Mid(result, intStartPos, intEndPos - intStartPos + 1)

            .Open "GET", myURL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .setRequestHeader "Cookie", strCookie
            .Send
            .waitForResponse 4000
            result = .responseText
            intTries = intTries + 1
        Loop

    End With

    'Extract the desired value from result
    intStartPos = InStr(1, result, "<RATE>") + 6
    intEndPos = InStr(1, result, "</RATE>") - 1

    If (intEndPos > 10) Then
        sngRate = CSng(Mid(result, intStartPos, intEndPos - intStartPos + 1))
    End If

CloseSub:
    GetExchangeRate = sngRate
    Set winHttpReq = Nothing
    Exit Function
FailedCurr:
    GoTo CloseSub
End Function

score 1 · Answer 2 · answered Jul 30 '17 at 19:41

You can use the MSXML2.ServerHttp60 object instead of WinHTTP so you can do more stuff with it, including setTimeOuts or setRequestHeader - for you, it might be worth a shot to visit the page and if you get the "Cookie" page, parse for the cookie, set the "Cookie" request header and then use the same object to resend the GET request. E.g. code below for how to set request headers:

Sub tester()
Dim objCON As MSXML2.ServerXMLHTTP60
Dim URL As String
Dim MYCOOKIE As String

MYCOOKIE = "ddddddd=978a2f9dddddddd_978a2f9d" '(Parsed from first visit)

Set objCON = New MSXML2.ServerXMLHTTP60

    URL = "http://www.boi.org.il/currency.xml?curr=01"

    objCON.Open "GET", URL, False
    objCON.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    objCON.setRequestHeader "Cookie", MYCOOKIE
    objCON.send

    MsgBox (objCON.responseText)

End Sub

Thanks! your idea of sending back the cookie in the header did the trick! However, I can't use MSXML2 in Excel VBA (besides, it strips off the cookie for security reasons). See my reply below with the working code. — Mor Sagmon, Jul 31 '17 at 19:30

WinHttpRequest in VBA only works if preceded by a Browser call

2 Answers2