IE fast automation

Question

I am currently trying to web scrape some exchange rates from a website called X-Rates, using VBA. My current problem is that it just takes too long to run. I have narrowed it down to the Do Events of my IE object.

My question: Is there a better way of doing this (maybe some better efficiency of code), or my logic is just flawed?

Here's what the code does:

1 - Loop for each country (1-9 = offsetCurr);

2- Convert to exchange rate and preserve value on cell

    'Define variables
    Dim strElm     As String
    Dim i          As Integer
    Dim ie         As InternetExplorer
    Dim period     As Variant
    Dim offsetCurr As Integer
    Dim offsetDesc As String

    'Define period
    period = Application.InputBox("What's the year and period?", "Period", , , , , 2)

    'Define start row
    i = 2

    Application.ScreenUpdating = False

    On Error GoTo ErrHandler

    For offsetCurr = 1 To 9

        If offsetCurr = 1 Then

            'ARS to EURO
            Set ie = New InternetExplorer
            offsetDesc = "ARS"
            Cells(i, 1).Value = period
            Cells(i, 2).Value = offsetDesc
            ie.navigate "http://www.x-rates.com/calculator/?from=ARS&to=EUR&amount=1"

            Do While ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop

            d = ie.document.getElementsByClassName("ccOutputRslt")(0).innerText
            strElm = d
            Cells(i, 3).Value = strElm

            ie.Quit
            Set ie = Nothing

            'ARS to USD
            Set ie = New InternetExplorer
            ie.navigate "http://www.x-rates.com/calculator/?from=ARS&to=USD&amount=1"

            Do While ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop

            d = ie.document.getElementsByClassName("ccOutputRslt")(0).innerText
            strElm = d
            Cells(i, 4).Value = strElm

            'Quit IE for automation purposes
            ie.Quit
            Set ie = Nothing

            'ARS to GBP
            Set ie = New InternetExplorer
            ie.navigate "http://www.x-rates.com/calculator/?from=ARS&to=GBP&amount=1"

            Do While ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop

            d = ie.document.getElementsByClassName("ccOutputRslt")(0).innerText
            strElm = d
            Cells(i, 5).Value = strElm

            ie.Quit
            Set ie = Nothing

        End If

ErrHandler:

    If Err.Number <> 0 Then
        Msg = "Error #" & Str(Err.Number) & " was generated by " & Err.Source & "." & Chr(13) & "Error description: " & Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
        Exit Sub
    End If

End Sub

I know it's a significant amount of code, if needed I can edit the question to make it simpler.

Answer 1

Here is an example showing how to retrieve rates via XHR:

Option Explicit

Sub TestGetRate()

    Dim sCrcy As Variant

    For Each sCrcy In Array("EUR", "USD", "GBP")
        Debug.Print GetRate("ARS", sCrcy)
    Next

End Sub

Function GetRate(sFromCrcy, sToCrcy)

    Dim sUrl, sContent

    sUrl = "http://www.x-rates.com/calculator/?from=" & sFromCrcy & "&to=" & sToCrcy & "&amount=1"
    With CreateObject("MSXML2.XMLHttp")
        .Open "GET", sUrl, False
        .send
        sContent = .ResponseText
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "<span class=""ccOutputRslt"">(.*?)<span class=""ccOutputTrail"">(.*?)</span><span class=""ccOutputCode"">(.*?)</span></span>"
        With .Execute(sContent).Item(0)
            GetRate = .SubMatches(0) & .SubMatches(1) & .SubMatches(2)
        End With
    End With

End Function

Output is as follows for me:

0.061688 EUR
0.070373 USD
0.048865 GBP

Answer 2

It looks like you are starting a new instance of IE and closing it completely for each of the 9 loops. Try starting IE once at beginning, then loop through each currency type, then quit IE.