Получение одного значения из JSON работает, но идентичный подход к другому не дает результатов

Question

Исходный файл .json так же прост:

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

Я могу вернуть значение "timestamp", но, используя тот же подход, я не могу вернуть значение "rate".

Это работает без проблем:

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

Но когда я пытаюсь заменить timestamp на rate, я получаю сообщение об ошибке, выделяющее строку MsgBox.

Ошибка времени выполнения '438':
Объект не поддерживает это свойство или метод

Я думаю, что проблема заключается в том, что VBA автоматически использует rate.

MsgBox oJSON.rates.EURUSD.rate

автоматически преобразуется в

MsgBox oJSON.rates.EURUSD.Rate

Как я могу вернуть значение "rate"?

Answer 1

Обходной путь может быть оценен:

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

Объект также может быть присвоен переменной JS (не проверено):

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

Answer 2

Управление сценариями будет работать для 32-битных, а не 64-битных.

Преимущество в следующем: будет работать на 32- и 64-битных машинах

---

Использование парсера json:

Я бы также использовал jsonconverter.bas (добавьте, затем добавьте ссылку на Microsoft Scripting Runtime), и, поскольку он возвращает внутри словарь, вы можете проверить ключ rate

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

---

Использование регулярного выражения:

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

---

Использование разделения строк:

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

Answer 3

Я использую этот инструмент для анализа ответа JSON следующим образом:

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

Попробуйте, таким образом, вы можете выполнить цикл позже, чтобы проверить все элементы внутри oJSON следующим образом: For Each Item in oJSON.Items и посмотрите, есть ли ставки.

Answer 4

Отличным решением для небольших проектов является использование функции CallByName.Не очень, но может выполнять работу в одной строке, и для этого не требуется импортировать внешние файлы в проект или добавлять ссылки.

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