I have this code. It converts an excel file to a json format. a, b, c... are my headers:

Public Sub json_file()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rangetoexport2 As Range
Dim rangetoexport3 As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
Dim rng As Range

Range("A1").Select
Selection.End(xlDown).Select
Dim lRow As Long
lRow = ActiveCell.Row

Set rangetoexport = Sheets(1).Range("A1:N" & lRow)
Set rangetoexport2 = Sheets(1).Range("H1:K" & lRow)
Set rangetoexport3 = Sheets(1).Range("L1:N" & lRow)

Set fs = CreateObject("Scripting.FileSystemObject")

Set jsonfile = fs.CreateTextFile("C:\Users\Desktop\Files\" & "jsondata.txt", True)

linedata = "["
jsonfile.WriteLine linedata

For rowcounter = 2 To rangetoexport.Rows.Count
linedata = ""
    For columncounter = 1 To 7
        linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
    Next
    linedata = Left(linedata, Len(linedata) - 1)
    
    For columncounter = 1 To 4
        linedata = linedata & """" & rangetoexport2.Cells(1, columncounter) & """" & ":" & "" & rangetoexport2.Cells(rowcounter, columncounter) & "" & ","
    Next
    linedata = Left(linedata, Len(linedata) - 1)
        
    For columncounter = 1 To 3
        linedata = linedata & """" & rangetoexport3.Cells(1, columncounter) & """" & ":" & """" & rangetoexport3.Cells(rowcounter, columncounter) & """" & ","
    Next
    linedata = Left(linedata, Len(linedata) - 1)
        
    
    If rowcounter = rangetoexport.Rows.Count Then
        linedata = "{" & linedata & "}"
    Else
        linedata = "{" & linedata & "},"
    End If
    jsonfile.WriteLine linedata
Next
linedata = "]"

jsonfile.WriteLine linedata
jsonfile.Close

Set fs = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

This is how the output looks like for one row:

{"a": "1234", "b": "0", "c": "true", "d": "true", "e": "1", "f": "24", "g": "null" (it doesn't put a comma here)"j": 151.70, "k": 1, "l": 2, "m": true, "n": "null", "y": "true", "z": "-1"}

I need it to look like this:

{
"a": "1234",
"b": 0,
"c": true,
"d": true,
"e": 1,
"f": 24,
"g": null,
"thresholdValues":
   {
    "j": 151.70,
    "k": 1,
    "l": 2,
    "m": true
   },
"n": null,
"y": true,
"z": -1
}

So I need to add , "thresholdValues": { at the beginning of header j, and }, at the end of header m. Is there a way to do this?

CodePudding user response：

Try

Option Explicit

Public Sub create_json_file2()
   
    Const FILENAME = "jsondata.txt"
    Const FOLDER = "C:\Users\Desktop\"
    Const q = """"

    Dim ar1, fso, ts
    Dim r As Long, c As Long, c2 As Long, lrow As Long
    Dim s As String

    lrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    ar1 = Sheets(1).Range("A1:N" & lrow).Value2
 
    ' build json string
    s = "[{" & vbCrLf

    For r = 2 To UBound(ar1)
        If r > 2 Then s = s & ",{" & vbCrLf

        For c = 1 To UBound(ar1, 2)
            If c > 1 Then s = s & "," & vbCrLf
            If c = 8 Then
                s = s & q & "thresholdValues" & q & ":{"
                For c2 = 0 To 3
                    If c2 > 0 Then s = s & ","
                     s = s & q & ar1(1, c2   c) & q & ":" 
                     If c2 = 0 then
                         s = s & ar1(r, c2   c)
                     Else
                         s = s & q & ar1(r, c2   c) & q
                     End If
                Next
                s = s & "}"
                c = c   3
            Else
                s = s & q & ar1(1, c) & q & ":" & q & ar1(r, c) & q
            End If
        Next
        s = s & "}" & vbCrLf
    Next
    s = s & "]"

    ' write out
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.CreateTextFile(FOLDER & FILENAME, True)
    ts.Write s
    MsgBox lrow - 1 & " rows exported to " & FOLDER & FILENAME, vbInformation
End Sub