Excel VBAでJSONをパースする

質問

と同じ問題があります。 Excel VBA。パースされた JSON オブジェクトのループ と同じ問題がありますが、解決策を見つけることができません。私のJSONは入れ子オブジェクトを持っているので、VBJSONやvba-jsonのような提案された解決策は私のために動作しません。私はまた、適切に動作するようにそれらの1つを修正しましたが、結果はdoProcess関数の多くの再帰のためにコールスタックオーバーフローでした。

最良の解決策は、元の投稿にある jsonDecode 関数のようです。これは非常に高速で非常に効果的です。私のオブジェクト構造はすべて、JScriptTypeInfo 型の汎用 VBA オブジェクトに含まれています。

この時点での問題は、オブジェクトの構造を決定できないことです。したがって、各ジェネリック オブジェクトに存在するキーを事前に知ることができないのです。キーやプロパティを取得するために、ジェネリックVBAオブジェクトをループする必要があります。

私の解析するjavascript関数がVBA関数またはサブをトリガーすることができれば、それは素晴らしいことです。

どのように解決するのですか？

の上に構築する場合 ScriptControl の上に構築したい場合、必要な情報を得るためにいくつかのヘルパーメソッドを追加することができます。その JScriptTypeInfo オブジェクトは少し残念なことに、関連するすべての情報を含んでいます (たとえば ウォッチ ウィンドウにあるように)すべての関連情報が含まれていますが、VBAでそれを取得することは不可能のようです。しかし、Javascript エンジンは私たちを助けてくれるでしょう。

Option Explicit

Private ScriptEngine As ScriptControl

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; } "
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
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function


Public Sub TestJsonAccess()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Value As Variant
    Dim j As Variant

    InitScriptEngine

    JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
    Set JsonObject = DecodeJsonString(CStr(JsonString))
    Keys = GetKeys(JsonObject)

    Value = GetProperty(JsonObject, "key1")
    Set Value = GetObjectProperty(JsonObject, "key2")
End Sub

ちょっとしたメモ

• もし JScriptTypeInfo のインスタンスが Javascript オブジェクトを参照している場合。 For Each ... Next は動作しません。しかし、Javascript の配列を参照している場合は動作します ( GetKeys 関数を参照)。
• 実行時にしか名前が分からないアクセスプロパティは、関数 GetProperty と GetObjectProperty .
• Javascriptの配列は、プロパティを提供します。 length , 0 , Item 0 , 1 , Item 1 などです。VBAのドット記法で( jsonObject.property という変数を宣言した場合のみ、length プロパティにアクセスできます。 length という変数をすべて小文字で宣言した場合のみアクセス可能です。そうでなければ、大文字と小文字が一致せず、見つけることができません。他のプロパティはVBAでは有効ではありません。ですから、より良いのは GetProperty 関数を使うのがよいでしょう。
• このコードでは、アーリーバインディングを使用しています。そのため、"Microsoft Script Control 1.0"への参照を追加する必要があります。
• を呼び出す必要があります。 InitScriptEngine を一度呼び出し、他の関数を使う前に基本的な初期化を行ってください。