Excel turns to JSON

As a result of the project needs, the specific Excel file needs to be extracted as JSON, after the Office2013 version of the plug-in Excel to JSON, found that only a worksheet conversion, and the conversion effect is not ideal;
The second way, the worksheet converted to CSV, and then by the Java parsing, so it is still a worksheet conversion, too troublesome.

But I have seen a little VBA before, so I summon up the courage to write VB script to solve the problem.

The following code for business reasons, can not have too many comments, Excel files can not provide, only to commemorate my persistence.

Sub Oprecors2json () Dim recordjsonstr As String Recordjsonstr = "{" Dim totalworksheets as Long                                ' How many worksheets Dim i As Long ' loop variable Dim j As Long

    ' Loop variable Dim k As Long ' loop variable Dim x as Long      
    ' Const declarations Const column_index_op_code As Long = 3 Const Column_index_op_field As Long = 5  Const COLUMN_INDEX_OP_FIELD_CN As Long = 7 Const Row_index_start As Long = 3 Dim currworksheet As worksheet ' current worksheet Dim Currrow as Range ' current row D Im Currcell as Range ' current cell Dim currcellvalue as String ' Curren T cell ' s value Dim currcellmergecount As Long ' current cell ' s merge ' s count Dim curropcode As S                   Tring     ' Operation code Dim Curropfield As String ' API field Dim CURROPFIELDCN as String ' API Field ' s Chinese Dim worksheetname As String ' curr Worksheet name Dim t                        Otalrows as Long ' how many rows in the current worksheet Dim Totalcolumns as Long ' How many columns in worksheet totalworksheets = Worksheets.count Const offset_field_op_code As Integer = Column_index_op_field-column_index_op_code Const offset_field_cn_op_code As Integer = Column_index_op_f Ield_cn-column_index_op_code for i = 1 to totalworksheets Set currworksheet = Worksheets (i) Workshe Etname = Currworksheet.name ' filter worksheet If (StrComp (trim2 (WorksheetName), "Notneededworksheet", VB Textcompare) = 0) Then GoTo notvalidworksheet end If totalrows = Currworksheet.range ("A6 5535 "). End (Xlup).
   Row     Totalcolumns = Currworksheet.range ("IV4"). End (xlToLeft). Column ' Printmsg (WorksheetName & ": & Totalrows &": "& Totalcolumns) ' Printmsg ("-

            ----------------------------------") for j = Row_index_start to Totalrows ' ignore the tow rows

                For k = Column_index_op_code to Totalcolumns ' Ignore one columns (sequence and API) If K <> Column_index_op_code _ and K <> Column_index_op_field _ and
                K <> column_index_op_field_cn Then GoTo notneededcolumn ' continue End If Set Currcell = Currworksheet.cells (j, K) ' current cell Currcellvalue = Currcel

                L.value ' current cell value Currcellmergecount = CurrCell.MergeArea.Rows.Count ' Current cell merge number If k = Column_index_op_code Then currcellvalue = trim2 (currCellvalue) Curropcode = Quotestr (currcellvalue) If VBA. IsNumeric (currcellvalue) Then ' Curropcode = CLng (currcellvalue) ' Printms G (WorksheetName & "-& J &" th row is number: "& Curropcode &", merged: "& Currcellmergecount ) ' Case If Currcellmergecount = 1 Then curr
                            Opfield = Quotestr (trim2 (curropfield)) CURROPFIELDCN = Quotestr (trim2 (CURROPFIELDCN)) Recordjsonstr = recordjsonstr & Curropcode & ": {" & Curropfield & ":" & Curropfiel DCN & "}," Else recordjsonstr = recordjsonstr & Curropcode &am P ': {' read directly from the current line, altogether currcellmergecount line for x = 1 to Currcellmerg Ecount CURROPFIEld = Currworksheet.cells (j + x-1, Column_index_op_field). Value CURROPFIELDCN = currworksheet.cells (j + x-1, COLUMN_INDEX_OP_FIELD_CN). Value Curropfield = Quotestr (trim2 (Curropfield)) Curropfie LDCN = Quotestr (trim2 (CURROPFIELDCN)) Recordjsonstr = recordjsonstr & Curropfield &am P
                                    ":" & CURROPFIELDCN If x <> currcellmergecount Then
                            Recordjsonstr = Recordjsonstr & "," End If Next Recordjsonstr = Recordjsonstr & "}," End If En D if End If Notneededcolumn:next opcodeisnull:next notvalidworksheet:n Ext ' Deletes the last comma, which is too cumbersome to handle in the loop and inefficient recordjsonstr = left (Recordjsonstr, Len (recordjsonstR)-1 RECORDJSONSTR = Recordjsonstr & "}" Write2file (RECORDJSONSTR) End Sub Public Sub Printmsg (ByVal msg Debug.Print msg End Sub public Function isnullstr (ByRef str as String) as Boolean Dim lenofstr as Long len OFSTR = Len (str) If lenofstr = 0 Then isnullstr = True Else isnullstr = False End If End Fun Ction Sub Write2file (ByVal content as String) Dim objstream as Object Set objstream = CreateObject ("ADODB". Stream ") Dim filename as String filename = application.getsaveasfilename (" Recordresult.json "," (*.json), *.json " If filename <> "False" Then with objstream. Type = 2. Charset = "UTF-8". Open. WRITETEXT content.  SaveToFile filename, 2 end with Else MsgBox "Save Failed", vbOKOnly, "Save as JSON" end If Set objstream
    = Nothing End Sub ' use double quote wrap string public Function quotestr (ByRef str As String) as StringQUOTESTR = Chr & str & CHR () End Function ' Some field descriptions have line-wrapping, double quotation marks, resulting in an error ' so write this function functions trim2 (ByVal str as str ing) as String str = Trim (str) str = replace (str, CHR (), "") str = Replace (str, CHR (), "") str = REPL
 Ace (str, CHR (), "") trim2 = str end Function

Welcome to the brick.