从 JSON 检索一个值有效，但对另一个值的相同方法失败

Question

源.json文件就这么简单：

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

我可以 return "timestamp" 值，但使用相同的方法我不能 return "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

但是当我尝试用 rate 替换 timestamp 时，我收到突出显示 MsgBox 行的错误消息。

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

我觉得问题出在VBA自动大写rate。

MsgBox oJSON.rates.EURUSD.rate

自动转换为

MsgBox oJSON.rates.EURUSD.Rate

我怎样才能 return "rate" 值？

Answer 1

我使用 this 工具来解析 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 2

脚本控制将适用于 32 位而不是 64 位。

以下优点是可以在 32 位和 64 位机器上工作

使用 json 解析器：

我还会使用 jsonconverter.bas（添加然后添加对 Microsoft Scripting Runtime 的引用），因为它 returns 里面有一个字典，您可以测试 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

小型项目的一个很好的解决方案是使用 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

Answer 4

解决方法可能是对其进行评估：

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

从 JSON 检索一个值有效，但对另一个值的相同方法失败

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

json

vba

autocorrect