VBAで変換できるExcelテーブルをjsonにすることが可能

Question

jsonに約20のカラムと多くの行を持つExcelテーブルからデータを変換する必要があります。私はvbaのこの目的のためのコードの短い例は見つかりませんでした。私はこれを見つけましたhttps://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas、しかしそれは非常に大きいです。より短い例がありますか？

Answer 1

私はこの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ライブラリを呼び出して配列を文字列に変換し（hat tip Douglas Crockford）、文字列をVBAに返します。 VBAでは文字列操作がありません。

JavaScriptの機能は次のとおりですが、ダグラス・クロフォードのライブラリhttps://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.jsに依存します。これをファイルに保存し、正しいファイルパスでVBAコードを修正し、JavaScriptが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}; 
    } 
} 

エクセル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