2016-10-21 11 views
0

私は以前の答えを試してみました。 JSON形式のサーバーから抽出された私のデータは私に複数のオブジェクトでキーを与えているまで、すべてが正常に動作しますVBAのJsonオブジェクトを読む

Excel VBA: Parsed JSON Object Loop

この {「messageCode」のようなもの:ヌル、「responseStatus」:「成功」 {"fxCcyPair": "USD"}、{"fxCcyPair": "EUR"}、{"fxCcyPair": "JPY"}、{" "resultObject2"の値を取得するにはどうすればよいですか? "resultObject2"の値はどのようにして取得できますか?私が参照する鍵がないので、オブジェクトからループを外すことができないためです。

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 

おかげ

+0

複数のアプローチがあります。リンク先の質問に記載されています:あなたの質問に使用しているコードを含めてください。 –

+0

@TimWilliamsご返信ありがとうございます。私はクエストインで自分のコードを更新 – user1560963

答えて

1

これは私が考えて、もう少し扱いやすいです

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 

(あなたのリンクの質問でS Meadenの回答に基づいて)出力:

success 
4 
USD 
EUR 
JPY 
GBD 
+0

ありがとう!できます – user1560963