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

Я использую инструмент это для анализа ответа 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 и посмотреть есть ли ставки.

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

Преимущество следующего заключается в том, что он будет работать на 32- и 64-битных машинах.

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

Я бы также использовал jsonconverter.bas (добавьте, а затем добавьте ссылку на среду выполнения сценариев Microsoft), и поскольку он возвращает словарь внутри, вы можете проверить ключ 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

Отличным решением для небольших проектов является использование функции 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

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

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