Excel – Saving Excel sheet as JSON file

jsonmicrosoft excel

Is there a simple way to convert a simple excel sheet to a JSON file?

For example the source sheet could look like:

   A           B
1 firstName   age
2 Alice       22
3 Bob         33

and the saved JSON:

[{firstName: 'Alice', age: 22}, {firstName: 'Bob', age: 33}]

Best Answer

  • I've combined jcbermu’s answer and JanHudecek’s answer with a UTF-8 version (snippets found here) which keeps accents and other Unicode goodness.

    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.

    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
    • Related Question