是否可以在 VBA 中将 Excel 表转换为 json

Question

我需要将大约 20 列和许多行的 excel 表中的数据转换为 json。我没有在 vba 中找到用于此目的的简短代码示例。我找到了这个https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas，但它非常大。可能是一个较短的例子？

Answer 1

我会使用这个的修改版本：http : //www.excelvbamacros.in/2015/01/export-range-in-jason-format.html

如果您想将其写入文件，则有一个代码：

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

Answer 2

所以我会将范围传递给一个 JavaScript 函数，让它遍历 Excel 对象模型并在 JavaScript 中构建数组。然后调用 JavaScript 库将数组转换为字符串（帽子提示 Douglas Crockford）并简单地将字符串返回给 VBA。所以在 VBA 中没有字符串操作。

JavaScript 函数如下所示，但取决于https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js上的 Douglas Crockford 库。将其保存在文件中，然后使用正确的文件路径修改 VBA 代码，以便将 JavaScript 加载到 Microsoft 脚本控件中。

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

Excel VBA 代码因此是

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