Get Currency from Web

Hi All

First time Ever doing web scraping...

I am wanting to extract USD to ZAR exchange rate

Any suggestions on how to get the correct element and change values...

Sub Auto_Open()
Dim URL As String, ExRt As Double, Obj As Object, Ele As Object
URL = "https://www.xe.com"
With CreateObject("InternetExplorer.Application")
    .Visible = True
    .navigate URL
    Do Until .ReadyState = 4: DoEvents: Loop
    Stop
    Set Obj = .document.getElementsByClassName("CurrencyInputWrapper-Djuqw fmFlNB")
    For Each Ele In Obj
        Debug.Print Ele.innerText
    Next Ele
End With
End Sub

Untitled.png

Using the URL you've given in your code, may be this;

Sub Test()
    'Haluk - 12/07/2020
    '
    Dim IE As Object, URL As String, i As Integer, elapsedTime As Long
    Dim RetVal As Object
    
    Const MAX_WAIT_SEC As Long = 5
    
    URL = "https://www.xe.com/currencyconverter/convert/?Amount=1&From=USD&To=ZAR"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
    
    elapsedTime = Timer
    
    Do While Not IE.ReadyState = 4
        DoEvents
    Loop
    
    Do
        If IE.Document.getElementsByClassName("sc-fzozJi dteCCc").Length > 0 Then Exit Do
        If Timer - elapsedTime > MAX_WAIT_SEC Then
            MsgBox "Waiting for too much..... aborted!"
            GoTo SafeExit:
        End If
    Loop
    
'   Alternative-1:
    MsgBox IE.Document.getElementsByClassName("sc-fzozJi dteCCc")(0).innerText      ' ZAR >> USD
    MsgBox IE.Document.getElementsByClassName("sc-fzozJi dteCCc")(1).innerText      ' USD >> ZAR
    
'   Alternative-2:
    Set RetVal = IE.Document.querySelectorAll(".sc-fzozJi.dteCCc")
    
    For i = 0 To RetVal.Length - 1
        MsgBox RetVal.Item(i).innerText
    Next
    
SafeExit:
    Set RetVal = Nothing
    IE.Quit
    Set IE = Nothing
End Sub

You are an absolute star...Thanks Haluk...

Sub Auto_Open()
Dim URL As String, ExRt As Double
URL = "https://www.xe.com/currencyconverter/convert/?Amount=1&From=USD&To=ZAR"
With CreateObject("InternetExplorer.Application")
    .Visible = True
    .navigate URL
    Do Until .readyState = 4: DoEvents: Loop
    ExRt = .document.getElementsByClassName("converterresult-toAmount")(0).innerText
    Debug.Print ExRt
End With
End Sub

It would be faster if you use API. You can register at this site for free https://currencylayer.com/ then to get API Key Access from Dashboard
Then this code can be used

Sub Test()
    Dim sAPIKey As String, sFrom As String, sTo As String, sURL As String
    sAPIKey = "Your APIKEY"
    sFrom = "USD": sTo = "ZAR"
    sURL = "http://apilayer.net/api/live?access_key=" & sAPIKey & "&currencies=" & sTo & "&source=" & sFrom & "&format=1"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sURL, False
        .send
        Debug.Print Val(Split(Split(.responseText, "" & sFrom & "" & sTo & """:")(1), vbLf)(0))
    End With
End Sub

Fantastic...Thanks Yasser

You're welcome. Thanks for the rep. points.

@sintek;

If you don't have to use the URL that you have given in your first message, then more effective alternatives can be offered as YasserKhalil has given in his message #5

Another alternative is; to get "Live Data" from investing.com without the need of a Web API, where XMLHTTP library is used.

In VBE, add the reference "Microsoft HTML Object Library" from "Tools>> References" menu. Then, run the code below:

Sub GetData()
    ' Haluk-13/07/2020
    '
    ' Reference: Microsoft HTML Object Library
    ' ---------------------------------------
    '
    Dim HTTP As Object, HTML As HTMLDocument
    Dim URL As String
   
    URL = "https://www.investing.com/currencies/single-currency-crosses"
   
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = New HTMLDocument
   
    HTTP.Open "GET", URL, False
    HTTP.send
   
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        
        Set Spans = HTML.getelementsByTagName("span")
        
        For Each xSpan In Spans
            If xSpan.getAttribute("data-name") = "USD/ZAR" Then
                spanID = xSpan.getAttribute("data-id")
                Exit For
            End If
        Next
    
        myID = ".pid-" & spanID
        
        myMsg = "Live Currency Cross - " & xSpan.getAttribute("data-name") & " (investing.com)" & vbCrLf & vbCrLf
        
        myMsg = myMsg & "Bid: " & Chr(9) & HTML.querySelector(myID & "-bid").innerText & vbCrLf & _
                        "Ask: " & Chr(9) & HTML.querySelector(myID & "-ask").innerText & vbCrLf & _
                        "High: " & Chr(9) & HTML.querySelector(myID & "-high").innerText & vbCrLf & _
                        "Low:" & Chr(9) & HTML.querySelector(myID & "-low").innerText & vbCrLf & _
                        "Time:" & Chr(9) & HTML.querySelector(myID & "-time").innerText
                
        MsgBox myMsg
    End If
    
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

Note: For different currency-crosses, all you need is to change the string in red color below accordingly (such as USD/EUR)

If xSpan.getAttribute("data-name") = "USD/ZAR" Then

Thanks for all the options guys...