VBAでJSONの値をパス指定で取得する

VBAでJSONの操作

Excel等のVBAで、JSONを操作するために、VBA-tools/VBA-JSON を利用しています。

次のJSON（文字列）を JsonConverter.ParseJsonで、オブジェクトに変換すれば、辞書（Dictionary）やコレクション（Collection）として、アクセスできます。

JSON（文字列）

{
  "persons": [
    {
      "name": "田中太郎",
      "age": 30,
      "contact": {
        "email": "[e-mail]",
        "phone": "090-1234-5678"
      },
      "address": {
        "city": "東京",
        "zip": "100-0001",
        "details": {
          "street": "銀座1丁目",
          "building": {
            "name": "サンシャインビル",
            "floor": 10,
            "room": "1005"
          }
        }
      },
      "hobbies": ["読書", "映画鑑賞", "旅行"],
      "work": {
        "company": "XYZ株式会社",
        "position": "エンジニア",
        "projects": [
          {
            "name": "AI開発",
            "duration": "2年",
            "technologies": ["Python", "TensorFlow", "AWS"]
          },
          {
            "name": "モバイルアプリ開発",
            "duration": "1年",
            "technologies": ["Swift", "Kotlin", "Firebase"]
          }
        ]
      }
    },
    {
      "name": "佐藤花子",
      "age": 28,
      "contact": {
        "email": "[e-mail]",
        "phone": "080-9876-5432"
      },
      "address": {
        "city": "大阪",
        "zip": "530-0001",
        "details": {
          "street": "梅田2丁目",
          "building": {
            "name": "グランドタワー",
            "floor": 8,
            "room": "805"
          }
        }
      },
      "hobbies": ["料理", "写真撮影", "登山"],
      "work": {
        "company": "ABC株式会社",
        "position": "デザイナー",
        "projects": [
          {
            "name": "UI/UXデザイン",
            "duration": "3年",
            "technologies": ["Figma", "Adobe XD", "CSS"]
          },
          {
            "name": "ブランドデザイン",
            "duration": "2年",
            "technologies": ["Illustrator", "Photoshop"]
          }
        ]
      }
    }
  ]
}

VBAのコーディング例

Sheet1シートのセルA1に、JSON(文字列)を入力し、DoJsonを実行します。
コレクションの添え字は1から始まります。

Sub DoJson()
    Dim json As String
    Dim obj As Object
    
    json = Sheet1.Range("a1")
    Set obj = JsonConverter.ParseJson(json)
    
    Debug.Print "DoJson >>>"
    Debug.Print obj("persons")(2)("name")
    Debug.Print obj("persons")(2)("work")("projects")(1)("technologies")(1)
    Debug.Print obj("persons")(2)("work")("projects")(1)("technologies")(2)
    Debug.Print obj("persons")(2)("work")("projects")(1)("technologies")(3)
    Debug.Print obj("persons")(2)("work")("projects")(1)("technologies")(4)
    Debug.Print "<<< DoJson"
    
End Sub

※ 最後の行で、実行時エラーが発生します。

ヘルパー関数：JsonPath

次のヘルパー関数を使うと、キーや添え字を一連のパス（文字列）にして、アクセスできます。

Option Explicit

Public Function JsonExtract(sourceObject As Object, queryPath As String, ByRef rItem As Variant) As Boolean
On Error GoTo ErrHandler
    Dim subQueryPath As String
    Dim subSourceObject As Object
    Dim s() As String
    Dim k As String
    Dim i As Integer
    Dim t As Variant
    Dim d As Dictionary
    Dim c As Collection
    
    ' Parse Key and/or Index
    s = Split(queryPath, "/", 2)  ' 0..1
    k = s(0)
    If UBound(s) > 0 Then
        subQueryPath = s(1)
    Else
        subQueryPath = ""
    End If
    If InStr(k, "[") > 0 Then
        k = Replace(k, "[", "/")
        k = Replace(k, "]", "")
        s = Split(k, "/")
        k = s(0)
        i = s(1) + 1   ' for Collection, Index = 1..
    Else
        i = -1
    End If
    
    ' Collection or Dictionary
    If k = "" Then
        Debug.Assert TypeName(sourceObject) = "Collection"
        Set t = sourceObject
    Else
        Debug.Assert TypeName(sourceObject) = "Dictionary"
        Set d = sourceObject
        If IsObject(d.Item(k)) Then
            Set t = d.Item(k)
        Else
            t = d.Item(k)
        End If
    End If
    
    ' Index
    If i > 0 Then
        Debug.Assert TypeName(t) = "Collection"
        Set c = t
        If IsObject(c.Item(i)) Then
            Set t = c.Item(i)
        Else
            t = c.Item(i)
        End If
    End If
    
    ' subQueryPath
    If subQueryPath <> "" Then
        Debug.Assert TypeName(t) = "Collection" Or TypeName(t) = "Dictionary"
        Set subSourceObject = t
        JsonExtract subSourceObject, subQueryPath, t
    End If
    
    ' return
    If IsObject(t) Then
        Set rItem = t
    Else
        rItem = t
    End If
    
    JsonExtract = True
ExitProc:
    Exit Function
ErrHandler:
    rItem = Empty
    Resume ExitProc
End Function

Public Function JsonPath(sourceJson As Variant, queryPath As String, Optional formatAsJson As Boolean = False) As Variant
    Dim obj As Object
    If IsObject(sourceJson) Then
        Set obj = sourceJson
    Else
        Set obj = JsonConverter.ParseJson(sourceJson)
    End If
    JsonExtract obj, queryPath, JsonPath
    If IsObject(JsonPath) And formatAsJson Then
        JsonPath = JsonConverter.ConvertToJson(JsonPath)
    End If
End Function

JsonPathを使ったコーディング例

キーと添え字（[]）を"/"で区切って、pathに指定します。
添え字（[]）は、0から始まります。
キーや添え字が存在しない場合、結果はEmptyです。

Sub DoJsonPath()
    Dim json As String
    Dim obj As Object
    
    json = Sheet1.Range("a1")
    Set obj = JsonConverter.ParseJson(json)
    
    Debug.Print "DoJsonPath >>>"
    Debug.Print JsonPath(obj, "persons[0]", True)
    Debug.Print JsonPath(obj, "persons[1]/name")
    Debug.Print JsonPath(obj, "persons[1]/work/projects[0]/technologies[0]")
    Debug.Print JsonPath(obj, "persons[1]/work/projects[0]/technologies[1]")
    Debug.Print JsonPath(obj, "persons[1]/work/projects[0]/technologies[2]")
    Debug.Print JsonPath(obj, "persons[1]/work/projects[0]/technologies[3]")
    Debug.Print "<<< DoJsonPath"
    
End Sub

JsonPathの戻り値
JsonPathの第3引数formatAsJsonをTrueにすると、戻り値がオブジェクト型の場合、JSON文字列が返ります。