CODEWITHSUNDEEP
jsonvba
mustafa53
mustafa53

Reputation: 103

how to create nested json file with vba

In my project, I'm creating a JSON file with VBA code. I want to create a nested JSON file to use my Excel cell's value. To do this I wrote the following code but it's not creating a nested JSON file and I don't know how to do it. 

Dim excelRange As Range
Dim jsonItems As New Collection
Dim jsonDictionary As New Dictionary
Dim jsonFileObject As New Scripting.FileSystemObject
Dim jsonFileExport As TextStream
Dim a As Long
Dim cell As Variant

Set excelRange = Cells(2, 1).CurrentRegion


For a = 2 To excelRange.Rows.Count
    jsonDictionary("refType") = Cells(a, 6)
    jsonDictionary("reference") = Cells(a, 1)
    jsonDictionary("engType") = "A5"
    jsonDictionary("DMC") = Cells(a, 16)
    jsonDictionary ("subTasks")

    jsonItems.Add jsonDictionary
    Set jsonDictionary = Nothing
Next a


Set jsonFileExport = jsonFileObject.CreateTextFile("C:\Users\ftk1187\Desktop\jsonExample.json", True)
jsonFileExport.WriteLine (JsonConverter.ConvertToJson(jsonItems, Whitespace:=3))

I want to create a nested JSON under the subTasks section. I want to do something like this. enter image description here

After a lot of tries and Koen's helps, I solve the problem. Final form of codes like this

Dim excelRange As Range
Dim jsonItems As New Collection
Dim jsonDictionary As New Dictionary
Dim jsonDictionary2 As New Dictionary
Dim jsonFileObject As New Scripting.FileSystemObject
Dim jsonFileExport As TextStream
Dim a As Long
Dim cell As Variant
Dim wrdArray() As String


Set excelRange = Cells(2, 1).CurrentRegion
k = 0
For a = 2 To excelRange.Rows.Count
    Set jsonDictionary = New Dictionary
    jsonDictionary("refType") = Cells(a, 6)
    jsonDictionary("reference") = Cells(a, 1)
    jsonDictionary("engType") = "A5"
    jsonDictionary("DMC") = Cells(a, 16)
    wrdArray() = Split(Cells(a, 17), ";")
    Set jsonDictionary2 = New Dictionary
    For c = 0 To UBound(wrdArray) - 1
            jsonDictionary2("SUBTASK" & c) = subs(c + k)
    Next c
    k = k + UBound(wrdArray)
    jsonDictionary.Add "subTasks", jsonDictionary2
    jsonItems.Add jsonDictionary
    'Set jsonDictionary = Nothing
    'Set jsonDictionary2 = Nothing
Next a


Set jsonFileExport = jsonFileObject.CreateTextFile("C:\Users\ftk1187\Desktop\jsonExample.json", True)
jsonFileExport.WriteLine (JsonConverter.ConvertToJson(jsonItems, Whitespace:=3))

Upvotes: 1

Views: 7914

Answers (3)

Harry Norton
Harry Norton

Reputation: 11

For anyone reading, in Koen's response, the final line:

d1.Add "subtasks", d2

should read:

d1.Add "subtasks", c2

That got it working for me!

Upvotes: 1

Сергей Колесников
Сергей Колесников

Reputation: 1

Export Excel to Nested JSON

Above code can be modified a bit to get a nested JSON as output. Just add dictionary in another dictionary so that it creates a nested JSON. code looks like this

Public Sub exceltonestedjson()
Dim rng As Range, items As New Collection, myitem As New Dictionary, subitem As New Dictionary, i As Integer, cell As Variant
Set rng = Range("A2:A3")
'Set rng = Range(Sheets(2).Range("A2"), Sheets(2).Range("A2").End(xlDown)) use this for dynamic range
i = 0
For Each cell In rng
Debug.Print (cell.Value)
myitem("name") = cell.Value
myitem("email") = cell.Offset(0, 1).Value
myitem("phone") = cell.Offset(0, 2).Value
subitem("country") = cell.Offset(0, 3).Value
myitem.Add "location", subitem
items.Add myitem
Set myitem = Nothing
Set subitem = Nothing
i = i + 1
Next
Sheets(2).Range("A4").Value = ConvertToJson(items, Whitespace:=2)
End Sub

Running above code looks like image below

Output : Output

Source

Upvotes: 0

Koen Rijnsent
Koen Rijnsent

Reputation: 260

Inspired by this post VBA-JSON Create nested objects -> try the following code. As you didn't post what your JSON should look like, I hope you can take it from here?

Set c1 = New Collection

For a = 2 To 3
    Set d1 = New Dictionary
    d1("refType") = "A"
    d1("reference") = 2 * a
    d1("engType") = "A5"
    d1("DMC") = "txt"

    Set c2 = New Collection
    For B = 10 To 12
        c2.add "nr-123-" & B
    Next B
    d1.Add "subtasks", d2
    c1.Add d1
Next a

TempTxt = JsonConverter.ConvertToJson(c1, Whitespace:=1)
Debug.Print TempTxt

Sample output:

[
 {
  "refType": "A",
  "reference": 4,
  "engType": "A5",
  "DMC": "txt",
  "subtasks": [
   "nr-123-10",
   "nr-123-11",
   "nr-123-12"
  ]
 },
 {
  "refType": "A",
  "reference": 6,
  "engType": "A5",
  "DMC": "txt",
  "subtasks": [
   "nr-123-10",
   "nr-123-11",
   "nr-123-12"
  ]
 }
]

There is one nasty bit: you cannot have multiple key-values with the same key in the same array. So your list of multiple "subtask" won't work. So you'd either have to hack them in afterwards or write them manually line by line. In this case I created an array for them.

Upvotes: 1

Related Questions