Retrieving one value from JSON works, but identical approach on the other value fails

Question

The source .json file is as simple as this:

{
  "rates": {
    "EURUSD": {
      "rate": 1.112656,
      "timestamp": 1559200864
    }
  },
  "code": 200
}

I can return the "timestamp" value, but using the identical approach I cannot return the "rate" value.

This runs with no problems:

Sub current_eur_usd()

  Dim scriptControl As Object
  Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
  scriptControl.Language = "JScript"
  Dim oJSON As Object

  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.freeforexapi.com/api/live?pairs=EURUSD", False
    .send
    Set oJSON = scriptControl.Eval("(" + .responsetext + ")")
    .abort
  End With
  MsgBox oJSON.rates.EURUSD.timestamp   '<<< 'timestamp' works, 'rate' fails

  Set oJSON = Nothing
  Set scriptControl = Nothing
End Sub

But when I try to replace timestamp with rate, I get the error message highlighting the MsgBox line.

Run-time error '438':
Object doesn't support this property or method

I think the problem lies in VBA automatically capitalizing rate.

MsgBox oJSON.rates.EURUSD.rate

auto-transforms into

MsgBox oJSON.rates.EURUSD.Rate

How can I return the "rate" value?

Check out [https://stackoverflow.com/questions/37710995/in-excel-vba-on-windows-how-to-mitigate-issue-of-dot-syntax-traversal-of-parsed] — , May 30 '19 at 09:29
@Gareth - huge thanks! I have explored all the options mentioned and referenced in this question and was able to find the best suiting solution, i.e. `CallByName` function. — ZygD, May 30 '19 at 12:29
Afterall, the [solution by Slai](https://stackoverflow.com/questions/56374289/#56378643) looks better to my eyes. — ZygD, May 30 '19 at 13:14

score 1 · Answer 1 · answered May 30 '19 at 08:21

1

I use this tool to parse the JSON response like this:

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.freeforexapi.com/api/live?pairs=EURUSD", False
    .send
    Set oJSON = ParseJson(.responseText)
    .abort
End With

Try that way, you can loop later to check all the items inside the oJSON like this: For Each Item in oJSON.Items and see if rates are there.

answered May 30 '19 at 08:21

Damian

5,152
1
10
21

Thank you for your input. I think on a bigger project this would be the way to go. However, if possible, I tend to avoid external tools and references. – ZygD May 30 '19 at 12:25

QHarr · Answer 2 · 2019-05-30T12:37:24.740

Script control will work for 32 bit rather than 64 bit.

The following have the advantage is will work on 32 and 64 bit machines

Using json parser:

I would also use jsonconverter.bas (add then add reference to Microsoft Scripting Runtime) and as it returns a dictionary inside you can test for the rate key

Option Explicit

Public Sub GetRate()
    Dim json As Object, pairs As String
    pairs = "EURUSD"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.freeforexapi.com/api/live?pairs=" & pairs, False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
        If json("rates")(pairs).Exists("rate") Then
            Debug.Print json("rates")(pairs)("rate")
        End If
    End With
End Sub

Using regex:

Option Explicit
Public Sub GetQuoteValue()
    Dim json As Object, pairs As String, s As String, re As Object
    Set re = CreateObject("VBScript.RegExp")
    pairs = "EURUSD"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.freeforexapi.com/api/live?pairs=" & pairs, False
        .send
        s = .responseText
        Debug.Print GetValue(re, s, """rate"":(\d+\.\d+)")
    End With
End Sub

Public Function GetValue(ByVal re As Object, inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
        If .Test(inputString) Then
            GetValue = .Execute(inputString)(0).SubMatches(0)
        Else
            GetValue = "Not found"
        End If
    End With
End Function

Using string splitting:

Option Explicit
Public Sub GetQuoteValue()
    Dim json As Object, pairs As String, s As String, p As String

    pairs = "EURUSD"
    p = """rate"":"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.freeforexapi.com/api/live?pairs=" & pairs, False
        .send
        s = .responseText
        If InStr(s, p) > 0 Then
            Debug.Print Split(Split(s, p)(1), ",")(0)
        End If
    End With
End Sub

Thank you for your input. I think on a bigger project this would be the way to go. However, if possible, I tend to avoid external tools and references. — ZygD, May 30 '19 at 12:24

Slai · Accepted Answer · 2019-05-30T13:30:24.317

1

A workaround could be evaluating it :

MsgBox scriptControl.Eval("(" + .responsetext + ").rates.EURUSD.rate")

The object can also be assigned to JS variable (not tested) :

Set EURUSD = scriptControl.Eval("EURUSD = (" + .responsetext + ").rates.EURUSD")
Debug.Print scriptControl.Eval("EURUSD.rate")
Debug.Print EURUSD.timestamp

edited May 30 '19 at 13:30

answered May 30 '19 at 12:48

Slai

22,144
5
45
53

In order for this to work, I had to put it inside the `With` block, but I do like the readability of this solution. As [QHarr](https://stackoverflow.com/users/6241235/qharr) explained, `scriptControl` will only work on 32 bit Office, but this is not an issue for me. Thank you! – ZygD May 30 '19 at 13:09

score 0 · Answer 4 · answered May 30 '19 at 12:21

A great solution for smaller projects is employing CallByName function. Not a pretty one, but can do the job in a single line, and it's not requiring to import external files to the project or add references.

Sub current_eur_usd()

  Dim scriptControl As Object
  Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
  scriptControl.Language = "JScript"
  Dim oJSON As Object

  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.freeforexapi.com/api/live?pairs=EURUSD", False
    .send
    Set oJSON = scriptControl.Eval("(" + .responsetext + ")")
    .abort
  End With
  MsgBox VBA.CallByName(VBA.CallByName(VBA.CallByName(oJSON, "rates", VbGet), "EURUSD", VbGet), "rate", VbGet)

  Set oJSON = Nothing
  Set scriptControl = Nothing
End Sub

Retrieving one value from JSON works, but identical approach on the other value fails

4 Answers4