1

I had tried the previous answer. Everything works fine until my data which extracted from server in the form of Json is giving me a key with multiple objects

Excel VBA: Parsed JSON Object Loop

something like this {"messageCode":null,"responseStatus":"success","message":null,"resultObject":null,"resultObject2":[{"fxCcyPair":"USD"}, {"fxCcyPair":"EUR"},{"fxCcyPair":"JPY"},{"fxCcyPair":"GBD"}],"resultObject3":null,"resultObject4":null}

How can I get the value in "resultObject2"? as there is no key for me to refer and I am not able to loop the object out from it.

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

Thanks

Community
  • 1
  • 1

1 Answers1

2

EDIT: if you use this approach to parse JSON then you should be aware there are some potentially serious security holes. The scriptcontrol doesn't behave like it's running JS in the browser (ie. there is no "sandbox") so you could open yourself up to something bad if you're not fully confident the "JSON" content is as expected.

This is a bit more manageable I think (based on S Meaden's answer at your linked question)

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

Output:

success
 4 
USD
EUR
JPY
GBD
Tim Williams
  • 154,628
  • 8
  • 97
  • 125