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
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