Search code examples
jsonexcelvba

Json Converter to table


I've been trying the VBA JsonConverter.

I have a json that looks like this:

{
    "payload": {
        "c": {
            "aa": "value_aa",
            "bb": "value_bb"
        },
        "k": {
            "aaa": "value_aaa",
            "bbb": "value_bbb"
        },
        "o": {
            "oa": "hallo",
            "odid": [
                "121",
                "222"
            ]
        }
    }
}

The result should look like this:

parameter   value
payload.c.aa    value_aa
payload.c.bb    value_bb
payload.k.aaa   value_aaa
payload.k.bbb   value_bbb
payload.o.oa    hallo
payload.o.odid1 121
payload.o.odid2 222

This is the best I've been to at the moment.
The list isn't like the result I want. The parameter is missing and the value isn't in the correct column.

Sub jsonListToExcel(jsonObject As Object, sheet As Worksheet, row As Long, col As Long)
    Dim i As Integer
    i = 1
    With sheet
        For Each element In jsonObject
            .Cells(row + i, col).Value = element
            i = i + 1
        Next element
    End With
End Sub

Sub jsonToExcel(jsonObject As Object, sheet As Worksheet, row As Long, col As Long, parentKey As String)
    For Each Key In jsonObject.Keys
        If TypeName(jsonObject(Key)) = "Dictionary" Then
            jsonToExcel jsonObject(Key), sheet, row, col, parentKey & "." & Key
        ElseIf TypeName(jsonObject(Key)) = "Collection" Then
            jsonListToExcel j
            sonObject(Key), sheet, row, col
        Else
            If Left(parentKey & "." & Key, 1) = "." Then
                sheet.Cells(row, col).Value = Right(parentKey & "." & Key, Len(parentKey & "." & Key) - 1)
            Else
                sheet.Cells(row, col).Value = parentKey & "." & Key
            End If
                
            sheet.Cells(row, col + 1).Value = jsonObject(Key)
            row = row + 1
        End If
    Next Key
End Sub
    
Sub Test1()
    Dim jsonText As String
    Dim jsonObject As Object
    
    Dim FSO As New FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    jsonText = "{""payload"":{""c"":{""aa"":""value_aa"",""bb"":""value_bb""},""k"":{""aaa"":""value_aaa"",""bbb"":""value_bbb""},""o"":{""oa"":""hallo"",""odid"":[""121"",""222""]}}}"
    
    Set jsonObject = JsonConverter.ParseJson(jsonText)
    
    jsonToExcel jsonObject, ActiveSheet, 1, 1, ""
End Sub

This should be completely independent by the Keys.


Solution

  • Add another parameter key to jsonListToExcel

    Sub jsonListToExcel(jsonObject As Object, key, sheet As Worksheet, row As Long, col As Long)
        Dim i As Integer, element
        i = 1
        If Left(key, 1) = "." Then key = Mid(key, 2)
        With sheet
            For Each element In jsonObject
                .Cells(row, col).Value = key & i
                .Cells(row, col + 1).Value = element
                i = i + 1
                row = row + 1
            Next element
        End With
    End Sub
    

    and the call

     jsonListToExcel jsonObject(key), parentKey & "." & key, sheet, row, col