[Solved] Get exchange rates – help me update URL in Excel VBA code that used to work [closed]


Split:

Now you have obtained the JSON string you can parse with Split function. Here I am reading the JSON in the comments from a cell

Option Explicit
Public Sub GetExchangeRate()
    Dim json As String
    json = [A1]
    Debug.Print Split(Split(json, """5. Exchange Rate"": ")(1), ",")(0)
End Sub

JSON Parser:

Here you can use a JSON parser, JSONConverter.bas and then add a reference via VBE > Tools > References > Microsoft Scripting Dictionary

Public Sub GetRate()
    Dim jsonStr As String, json As Object
    jsonStr = [A1]
    Debug.Print JsonConverter.ParseJson(jsonStr)("Realtime Currency Exchange Rate")("5. Exchange Rate")
End Sub

This is the path to your desired change rate:

enter image description here

The initial object is a dictionary containing another dictionary. Dictionaries are denoted by {}. You access the first dictionary with the key Realtime Currency Exchange Rate and then the required value, from the inner dictionary, by the associated key: 5. Exchange Rate


Whole request with JSON parser:

Option Explicit
Public Sub GetRate2()
    Dim URL As String, json As String, http As Object
    URL = "https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=EUR&to_currency=USD&apikey=yourAPIkey"
    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        json = .responseText
    End With
    Debug.Print JsonConverter.ParseJson(json)("Realtime Currency Exchange Rate")("5. Exchange Rate")
End Sub

As an UDF:

Option Explicit
Public Sub Test()
    Debug.Print CurrencyConverter("EUR", "USD")
End Sub

Public Function CurrencyConverter(ByVal FromCurrency, ByVal ToCurrency) As String
    Dim URL As String, json As String, http As Object
    URL = "https://www.alphavantage.co/query?function=CURRENCY_EXCHANGE_RATE&from_currency=" & FromCurrency & "&to_currency=" & ToCurrency & "&apikey=yourAPIkey"

    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        json = .responseText
    End With
    CurrencyConverter = JsonConverter.ParseJson(json)("Realtime Currency Exchange Rate")("5. Exchange Rate")
'CurrencyConverter = Replace$(JsonConverter.ParseJson(json)("Realtime Currency Exchange Rate")("5. Exchange Rate"), Application.DecimalSeparator, ".") 
End Function

To use split function replace penultimate function line with

CurrencyConverter = Replace$(Split(Split(json, """5. Exchange Rate"": ")(1), ",")(0), Chr$(34), vbNullString)

2

solved Get exchange rates – help me update URL in Excel VBA code that used to work [closed]