Question

我曾尝试过上一个答案。一切正常，直到我以Json的形式从服务器中提取的数据给我一个包含多个对象的密钥

像这样的事情 {＆＃34; messageCode＆＃34;：空，＆＃34; responseStatus＆＃34;：＆＃34;成功＆＃34;＆＃34;消息＆＃34;：空，＆＃34; resultObject＆＃34 ;: null，＆＃34; resultObject2＆＃34;：[{＆＃34; fxCcyPair＆＃34;：＆＃34; USD＆＃34;}，{＆＃34; fxCcyPair＆＃34;：＆＃34; EUR＆＃34; }，{＆＃34; fxCcyPair＆＃34;：＆＃34; JPY＆＃34;}，{＆＃34; fxCcyPair＆＃34;：＆＃34; GBD＆＃34;}]，＆＃34; resultObject3＆＃34 ;：空，＆＃34; resultObject4＆＃34;：空}

如何在＆＃34; resultObject2＆＃34;中获取值？因为我没有关键参考，我无法将对象从中循环出来。

Public Sub InitScriptEngine()
    Set ScriptEngine = New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
    ScriptEngine.AddCode "function getSentenceCount(){return obj.sentences.length;}"
    ScriptEngine.AddCode "function getSentence(i){return obj.sentences[i];}"
End Sub

Public Function DecodeJsonString(ByVal JsonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function

Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    index = 0
    For Each Key In KeysObject
        KeysArray(index) = Key
        Debug.Print Key
        index = index + 1
    Next
    GetKeys = KeysArray
End Function

由于

Answer 1

我认为这更容易管理（基于S Meaden在你的链接问题上的回答）

Sub TestJSONParsingWithVBACallByName()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim objJSON As Object, arr As Object, el

    'I pasted your JSON in A1 for testing...
    Set objJSON = oScriptEngine.Eval("(" + Range("A1").Value + ")")

    Debug.Print VBA.CallByName(objJSON, "responseStatus", VbGet) 

    'get the array associated with "resultObject2"
    Set arr = VBA.CallByName(objJSON, "resultObject2", VbGet)

    Debug.Print VBA.CallByName(arr, "length", VbGet) 'how many elements?

    'loop over the array and print each element's "fxCcyPair" property
    For Each el In arr
        Debug.Print VBA.CallByName(el, "fxCcyPair", VbGet)
    Next el

End Sub

输出：

success
 4 
USD
EUR
JPY
GBD

在VBA中读取Json对象

1 个答案: