Created
March 26, 2019 19:33
-
-
Save NickStrupat/9fa7af085d9f4cd0566791185a507a96 to your computer and use it in GitHub Desktop.
UTF-8 and double quote escaping. It saves the file beside the active workbook file but with the .json file extension. It's fast. It can be easily formatted in VS Code (Shift + Alt + F). To use it, hit Alt + F11 to get to the VBA code editor, open the code for your active worksheet, then paste it into the code window. Hit F5 to run.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Public Sub tojson() | |
Dim fso As Object | |
Set fso = CreateObject("Scripting.FileSystemObject") | |
jsonFilename = fso.GetBaseName(ActiveWorkbook.Name) & ".json" | |
fullFilePath = Application.ActiveWorkbook.Path & "\" & jsonFilename | |
Dim fileStream As Object | |
Set fileStream = CreateObject("ADODB.Stream") | |
fileStream.Type = 2 'Specify stream type - we want To save text/string data. | |
fileStream.Charset = "utf-8" 'Specify charset For the source text data. | |
fileStream.Open 'Open the stream And write binary data To the object | |
Dim wkb As Workbook | |
Set wkb = ThisWorkbook | |
Dim wks As Worksheet | |
Set wks = wkb.Sheets(1) | |
lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column | |
lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row | |
Dim titles() As String | |
ReDim titles(lcolumn) | |
For i = 1 To lcolumn | |
titles(i) = wks.Cells(1, i) | |
Next i | |
fileStream.WriteText "[" | |
dq = """" | |
escapedDq = "\""" | |
For j = 2 To lrow | |
For i = 1 To lcolumn | |
If i = 1 Then | |
fileStream.WriteText "{" | |
End If | |
cellvalue = Replace(wks.Cells(j, i), dq, escapedDq) | |
fileStream.WriteText dq & titles(i) & dq & ":" & dq & cellvalue & dq | |
If i <> lcolumn Then | |
fileStream.WriteText "," | |
End If | |
Next i | |
fileStream.WriteText "}" | |
If j <> lrow Then | |
fileStream.WriteText "," | |
End If | |
Next j | |
fileStream.WriteText "]" | |
fileStream.SaveToFile fullFilePath, 2 'Save binary data To disk | |
a = MsgBox("Saved to " & fullFilePath, vbOKOnly) | |
End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment