Convert dictionary of String as Key and Array as value into a JSON object in VBA-CodePudding

result_dict = {
   "outer_key" : [
         {
            "key_a": "val",
            "key_b": "val",
            "key_c": "val",
         },
         {
            "key_a": "val",
            "key_b": "val",
            "key_c": "val",
         }
         ... 24 more dicts
    ]
}

This created this dictionary from a table in excel. I would like to convert this dictionary into JSON and send a POST request with this JSON body to an API endpoint.

QN: How can I convert this result_dict (which has Key as String and Value as Array) into a JSON object in VBA? Without using any 3rd party library or dependency due to restrictions.

I'm happy to listen to ideas to better structure my request body but I've realised that on the API side, this format seems the easiest to convert into a DTO without too much nesting going on.

CodePudding user response：

Build the json string directly from the table, no need for dictionary.

Option Explicit

Sub buildjson()

    Dim tbl As ListObject, r As Long, c As Long
    Dim s As String, ar(25) As String, json As String
    Dim key, data
    
    key = Array("key_a", "key_b", "key_c")
    Set data = Sheet1.ListObjects("Table1").DataBodyRange
   
    For c = 1 To 26
       s = "  {" & vbCrLf
       For r = 1 To 3
           s = s & "    '" & key(r - 1) & "' : '" _
                 & data.Cells(r, c) & "'," & vbCrLf
       Next
       ar(c - 1) = s & "  }"
    Next
    s = "{" & vbCrLf & "'outer key' : [" & vbCrLf & _
        Join(ar, "," & vbCrLf) & " ]" & vbCrLf & _
        "}"
        
    json = Replace(s, "'", """")
    Debug.Print json
    
End Sub

CodePudding user response：

Similar to the existing answer - slightly different approach to directly building a string:

Sub tester()
    Debug.Print TableToJson(Selection, "outerKey")
End Sub

Function TableToJson(rng As Range, dataKey As String)
    Dim j As String, rw As Long, col As Long, data, sep
    
    data = rng.Value
    j = "{""" & dataKey & """:["
    For rw = 2 To UBound(data, 1)
        sep = IIf(rw = 2, "", ",") 'need comma?
        j = j & sep & vbLf & "{" & vbLf
        For col = 1 To UBound(data, 2)
            sep = IIf(col = UBound(data, 2), "", ",") 'need comma?
            j = j & """" & data(1, col) & """:""" & data(rw, col) & """" & sep & vbLf
        Next col
        j = j & "}"
    Next rw
    TableToJson = j & vbLf & "]}"
End Function

If you need to translate the table headers into different JSON property names you could also pass in a dictionary to perform that mapping.