JSONファイルをVBAで読み込んでexcelの表形式に変換したい。(PowerQueryを使わずに)

Question

下記のようなjsonをVBAだけを使ってエクセルに出力したいです。

[
  {
    "AA": "XXXX1",
    "BB": {
           "B1": "XXXX2",
           "B2": {"DDD": "XXXX3"},
           "B3": {
                   "EE1": "XXXX4",
                   "EE2": "XXXX5"
                 }
          },
    "CC": "XXXX6",
    "DD": {"D1": "XXXX7"},
    "EE": {
           "G1": "XXXX8",
           "G2": "XXXX9"
          }
  },
  {
    "AA": "XXX10",
    "BB": {
  以降、省略
  },
  {
  以降、省略
  }
]

下記のような出力イメージで考えているのですが、微妙なネスト状態になっているので
アイデアが思い浮かびません。。。。
jsonファイルは、見やすいように改行しましたが、これが全部、改行無しでくっついて
一行扱いになっているのでどうやって、VBAで読み込んだらいいか、調べているところです。
どなたか、ご教授いただけると助かります。。。
ちなみに、上記のデータセットは「以降、省略」と記載されている部分だけで5000セットくらいあります。
あたまの”AA"が5000千回くるかんじです。

実現したいことを整理します。
VBAで下記のコードを実現したいのです。
・改行が無いため先頭から読み込む。
・先頭から読み込みながら、「: {」があったら階層を一つ下がって「BB.B3.EE1」して、
その値を読み込む。
・「}」があれば一つ階層を上げる。(「BB.B3」階層に戻る)
・項目はエクセルの一行目と一致したら出力する。

上記を実現する方法をＶＢＡで書きたい。。。
と思って調べているところです。。「先頭から読み込む」では無く「一行づつ」なら、いけそうな
感じもするのですが、、、、。

    Dim buf, str As String
    With CreateObject("Scripting.FileSystemObject")
        With .GetFile("D:\XXX\ex.json").OpenAsTextStream
            buf = .ReadAll
            .Close
        End With
    End With
    buf = Replace(buf, "[", "")
    buf = Replace(buf, "]", "")
    Dim Json: Set Json = JsonConverter.ParseJson(buf)
    MsgBox Json("AA")

VBA-JSONを使って上記のように記載した場合は、最初の"AA"は取り出すことができますが、二週目の"AA"の"XXX10"が取り出すことができなくて困っています。二週目の"AA"の値が指定して取り出せれば、VBA-JSONでも構いません。
jsonファイルに同じ名前の付いた２週目のファイルの取り出し方が分からなかったため、他の方法を探していた次第です。

使用環境は 64bit版エクセルとなります。

上記のVBA-JSONはcx20さんが教えてくださった下記を使用しています。
■ VBA-JSON
https://github.com/VBA-tools/VBA-JSON

Comments

[meg_]

> 微妙なネスト状態になっているので
普通のjsonファイルに見えますが、どのあたりが"微妙なネスト状態"なんでしょうか？

> 上記のデータセットは5000セットくらいあります
jsonファイルが5000ファイルという意味でしょうか？

[cx20]

VBA だと VBA-JSON というライブラリがあるようですね。（使ったことは無いですが）
項目が固定であれば単純に項目数分マップすればよいかと思います。
項目が非構造（もしくは複雑）な場合、マップは難しいかも知れないですね。。

■ VBAでparseしたJSONデータの要素を取得する方法
https://dampgblog.hinohikari291.com/jsonparse/
■ VBA-JSON
https://github.com/VBA-tools/VBA-JSON

[nkiki]

meg_さん
ご指摘ありがとうございます。
普通のjsonファイルですね。申し訳ありません。
jsonファイルは一つです。その中に5000個分ほどの{}のセットが並びます。

cx20さん
情報ありがとうございます。
VBAで下記のコードを実現したいのです。。。
・改行が無いため先頭から読み込む。
・先頭から読み込みながら、「: {」があったら階層を一つ下がって「BB.B2.DDD」とする。
・「}」があれば一つ階層を上げる。
・項目はエクセルの一行目と一致したら出力する。

VBA-JSONの存在は私も知っていましたが、上記を実現する方法をＶＢＡで書きたい。。。
と思って調べているところです。。「先頭から読み込む」では無く「一行づつ」なら、いけそうな
感じもするのですが、、、、。

[退会済みユーザー]

書きたいなら書けばいいじゃないですか。質問文見るに漠然としすぎていて、何も書いてるように見えませんが。作ってる過程で不明な点があるなら、その部分をピンポイントで質問してください。そういうものを作って欲しいという話であれば、お金出してどっかに依頼してください。
[推奨していない質問] https://teratail.com/help/avoid-asking
[質問するときのヒント] https://teratail.com/help/question-tips

[退会済みユーザー]

外部ライブラリ（VBA-JSON）を使用したのであれば、そこのリンクも貼るようにしてください。リンクの挿入（鎖アイコン）を使用するとよいです。

Answer 1

【追記】
VBA-JSONを使用した例です。
下記ではDebug.Printを使用して動作確認しています。
必要に応じて配列に入れるなど工夫してください。

jsonの階層がもっと深い場合には再帰処理した方が良さそうです。

Sub test()

    Dim fso As Object
    Dim json As Object
    Dim jsonText As String
    Dim jsonParse As Object
    Dim i As Variant
    Dim j As Variant
    Dim k As Variant
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set json = fso.OpenTextFile("C:\Users\test.json", 1)
    jsonText = json.ReadAll
    json.Close
    
    Set jsonParse = JsonConverter.ParseJson(jsonText)
    
    For Each i In jsonParse
        For Each j In i
            Debug.Print j
            If VarType(i(j)) = 9 Then
                For Each k In i(j)
                    Debug.Print k
                    If VarType(i(j)(k)) = 9 Then
                        For Each m In i(j)(k)
                            Debug.Print m
                            Debug.Print i(j)(k)(m)
                        Next m
                    Else
                        Debug.Print i(j)(k)
                    End If
                Next k
            Else
                Debug.Print i(j)
            End If
        Next
    Next i

End Sub

---

Excel32bit版の場合です

[VBA]VBAでjsonをパースするを参考に作ってみました。

[
  {
    "AA": "XXXX1",
    "BB": {
           "B1": "XXXX2",
           "B2": {"DDD": "XXXX3"},
           "B3": {
                   "EE1": "XXXX4",
                   "EE2": "XXXX5"
                 }
          },
    "CC": "XXXX6",
    "DD": {"D1": "XXXX7"},
    "EE": {
           "G1": "XXXX8",
           "G2": "XXXX9"
          }
  }
]

Option Explicit

Sub test()

    Dim buf As String
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile "./test.json"
        buf = .ReadText
        .Close
    End With
    
    Dim obj As Object
    Dim json As Object
    Dim json2 As Object
    Dim json3 As Object
    Dim json4 As Object
    Dim i As Variant
    Dim j As Variant
    Dim k As Variant

    Set obj = CreateObject("ScriptControl")
    obj.Language = "JScript"
    obj.AddCode "function jsonParse(s){ return eval('('+s+')');}"

    Set json = obj.codeobject.jsonParse(buf)
    Set json2 = CallByName(json, 0, VbGet)
    
    Dim js As Object
    Dim keys As Object
    Dim keys2 As Object
    Dim keys3 As Object
    
    Set js = CreateObject("ScriptControl")
    js.Language = "JScript"
    js.AddCode "function getKeys(h) { var keys=[]; for(var k in h){keys.push(k);} return keys; };"
 
    Set keys = js.codeobject.getKeys(json2)
    For Each i In keys
        Debug.Print i
        If Not CallByName(json2, i, VbGet) = "[object Object]" Then
            Debug.Print CallByName(json2, i, VbGet)
        Else
            Set keys2 = js.codeobject.getKeys(CallByName(json2, i, VbGet))
            For Each j In keys2
                If Not CallByName(json2, i, VbGet) = "[object Object]" Then
                    Debug.Print json3
                Else
                    Set json3 = CallByName(json2, i, VbGet)
                    Debug.Print j
                    If Not CallByName(json3, j, VbGet) = "[object Object]" Then
                        Debug.Print CallByName(json3, j, VbGet)
                    Else
                        Set json4 = CallByName(json3, j, VbGet)
                        Set keys3 = js.codeobject.getKeys(CallByName(json3, j, VbGet))
                        For Each k In keys3
                            Debug.Print k
                            Debug.Print CallByName(json4, k, VbGet)
                        Next
                    End If
                End If
            Next
        End If
    Next
    
End Sub

'AA
'XXXX1
'BB
'B1
'XXXX2
'B2
'DDD
'XXXX3
'B3
'EE1
'XXXX4
'EE2
'XXXX5
'CC
'XXXX6
'DD
'D1
'XXXX7
'EE
'G1
'XXXX8
'G2
'XXXX9

この方法は使いやすいとは言えないので他の方法の方が良いかと思います。
JSONファイルを扱うのであればjavascriptやPythonが扱いやすいのではないかと思います。

Comments

[nkiki]

色々とありがとうございます。私の質問の仕方がものすごく悪く、他の方からも指摘されている上で時間を割いていただきありがとうございます。
私の使っているExcelが64bit版になります。。。
「Set js = CreateObject("ScriptControl")」部分でエラーになるため、VBA-Jsonか、自力か。。。を考えているところです。

Answer 2

    buf = Replace(buf, "[", "")
    buf = Replace(buf, "]", "")

ここで置換しているせいで、正しくJSONを解釈出来ていないのでは？
ここをコメントアウトして質問文っぽい感じのJSONを読ませてみましたが、特に問題なさそうですが。

Comments

[nkiki]

おおお！まさしく私が知りたかったのは、一週目が「Json(1)("AA")」で二週目が「Json(2)("AA")」でアクセスできる手法でした。。。
言いたいことが正確に表現できずに申し訳ありません。
みなさま、本当にありがとうございます。