Macro to Export Range in Json Format
Option Explicit
Sub export_in_json_format()
Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
' change range here
Set rangetoexport = Sheet1.Range("a1:d8")
Set fs = CreateObject("Scripting.FileSystemObject")
' change dir here
Set jsonfile = fs.CreateTextFile("C:\Users\xx\Desktop\" & "jsondata.json", True)
linedata = "{""Output"": ["
jsonfile.WriteLine linedata
For rowcounter = 2 To rangetoexport.Rows.Count
linedata = ""
For columncounter = 1 To rangetoexport.Columns.Count
linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.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
End Sub
Option Explicit
Sub export_in_json_format()
Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
' change range here
Set rangetoexport = Sheet1.Range("a1:d8")
Set fs = CreateObject("Scripting.FileSystemObject")
' change dir here
Set jsonfile = fs.CreateTextFile("C:\Users\xx\Desktop\" & "jsondata.json", True)
linedata = "{""Output"": ["
jsonfile.WriteLine linedata
For rowcounter = 2 To rangetoexport.Rows.Count
linedata = ""
For columncounter = 1 To rangetoexport.Columns.Count
linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.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
End Sub
I like your article,keep spirit boz..
ReplyDeletebisnis sampingan download software dan game gratis terbaru care health, care and beauty bisnis online gratis health women bisnis rumahan ibu judul skripsi pai jilbab murah health, care and business game uang usaha online cyst how to newest how to newest The above article is nice and interesting, thank you willing to share!.. Very GOOD..Interesting article
This works really well! Thanks!
ReplyDeleteThanks, this a real good code
ReplyDeleteim add some change to ensure that the result remained in the folder with the sheet, and with a different name (using the current time and date for the name):
' change range here
Set rangetoexport = Worksheets("Blad1").Range("$A:$J")
Set fs = CreateObject("Scripting.FileSystemObject")
Set jsonfile = fs.CreateTextFile(ActiveWorkbook.Path & "\" & Format(Date, "dd-mm-yy") & Format(Time(), "-hh-mm-ss") & ".json", True)
This tutorial is really useful for me, thanks a lot.
ReplyDeleteThanks! This is very cool and saved me a lot of time. My spreadsheet had some "special" characters like �� and \.
ReplyDeleteThe first change to support the picture was to add a second True to create the file as Unicode.
Set jsonfile = fs.CreateTextFile("C:\Users\scottcr\Desktop\" & "jsondata.json", True, True)
The second change was to add a replace function to escape \ to \\.
linedata = Replace(linedata, "\", "\\")
Here's the complete updated version if anybody is interested.
Option Explicit
Sub Update()
Dim waitTime As Integer
Dim timesRun As Integer
waitTime = 20
timesRun = 0
AreaPathMain.Main timesRun, waitTime
End Sub
Sub tableToJson()
Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String
' change range here
Set rangetoexport = Sheet1.Range("B2:F116")
Set fs = CreateObject("Scripting.FileSystemObject")
' change dir here
Set jsonfile = fs.CreateTextFile("C:\Users\scottcr\Desktop\" & "jsondata.json", True, True)
linedata = "{""Output"": ["
jsonfile.WriteLine linedata
For rowcounter = 2 To rangetoexport.Rows.Count
linedata = ""
For columncounter = 1 To rangetoexport.Columns.Count
linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
Next
linedata = Left(linedata, Len(linedata) - 1)
If rowcounter = rangetoexport.Rows.Count Then
linedata = "{" & linedata & "}"
Else
linedata = "{" & linedata & "},"
End If
linedata = Replace(linedata, "\", "\\")
jsonfile.WriteLine linedata
Next
linedata = "]}"
jsonfile.WriteLine linedata
jsonfile.Close
Set fs = Nothing
End Sub