Is it possible in VBA convert Excel table to json

Question

I need convert data from excel table with about twenty columns and a lot of rows into json. I don't found a short example of code for this purpose in vba. I found this one https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas , but it is very large. May be it is a shorter example?

Solution 1

I'd go with modified version of this one: http://www.excelvbamacros.in/2015/01/export-range-in-jason-format.html

if you want to write it to file there's a code:

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim Fileout As Object
Set Fileout = fso.CreateTextFile("C:\some_dir\mydata.json", True, True)
Fileout.Write jsonStringFromConvertFunction
Fileout.Close

Solution 2

So I would pass in the range to a JavaScript function and let it iterate over the Excel object model and build the array in JavaScript. Then call a JavaScript library to convert array into a string (hat tip Douglas Crockford) and simply return the string to VBA. So no string operations in VBA.

The JavaScript function is given below but depends upon Douglas Crockford's library at https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js. Save this in a file and then amend VBA code with the correct file path so the JavaScript is loaded into the Microsoft Script Control.

function ExcelTableToJSON(rngTable) {
    try {
        if (rngTable && rngTable['Rows'] && rngTable['Columns']) {
            var rowCount = rngTable.Rows.Count;
            var columnCount = rngTable.Columns.Count;
            var arr = new Array();

            for (rowLoop = 1; rowLoop <= rowCount; rowLoop++) {
                arr[rowLoop - 1] = new Array();
                for (columnLoop = 1; columnLoop <= columnCount; columnLoop++) {
                    var rngCell = rngTable.Cells(rowLoop, columnLoop);
                    var cellValue = rngCell.Value2;
                    arr[rowLoop - 1][columnLoop - 1] = cellValue;
                }
            }
            return JSON.stringify(arr);
        }
        else {
            return { error: '#Either rngTable is null or does not support Rows or Columns property!' };
        }
    }
    catch(err) {
        return {error: err.message};
    }
}

The Excel VBA code is thus

Option Explicit

'In response to
'http://stackoverflow.com/questions/38100193/is-it-possible-in-vba-convert-excel-table-to-json?rq=1
'Is it possible in VBA convert Excel table to json

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Private Sub Test()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    oScriptEngine.AddCode GetJavaScriptLibraryFromWeb("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")

    Dim sJavascriptCode As String
    sJavascriptCode = CreateObject("Scripting.FileSystemObject").GetFile("<<<Your file path to javascript file>>>\ExcelTableToJSON.js").OpenAsTextStream.ReadAll

    oScriptEngine.AddCode sJavascriptCode

    Dim rngTable As Excel.Range
    Set rngTable = ThisWorkbook.Worksheets.Item("Sheet2").Range("A1:B2")

    rngTable.Cells(1, 1) = 1.2
    rngTable.Cells(1, 2) = "red"
    rngTable.Cells(2, 1) = True
    rngTable.Cells(2, 2) = "=2+2"


    Dim sStringified As String
    sStringified = oScriptEngine.Run("ExcelTableToJSON", rngTable)
    Debug.Assert sStringified = "[[1.2,""red""],[true,4]]"

    Stop

End Sub

Public Function GetJavaScriptLibraryFromWeb(ByVal sURL As String) As String

    Dim xHTTPRequest As Object 'MSXML2.XMLHTTP60
    Set xHTTPRequest = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibraryFromWeb = xHTTPRequest.responseText

End Function