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

我使用Link工具来解析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的引用），因为它返回了一个字典，您可以在其中测试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

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

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 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

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

4 个答案: