SoFunction
Updated on 2025-03-10

VBA generates JSON file to excel data table

Create a UTF-8+BOM-encoded text file.

Then iterate through the data area, format the data, and output it.

Small data is OK, big data has not been tested.

In addition, the text file created using fso is encoded as ANSI, and garbled code occurs when ajax parses json and cannot be parsed normally.

Sub ToJson() 'createUTF8Text file
 myrange = Worksheets("sheet1").UsedRange 'Select data through valid data area
  'myrange = ("schoolinfo").RefersToRange 'Select data by the defined name
  'myrange = Range(Worksheets("sheet1").Range("a1").End(xlDown), Worksheets("sheet1").Range("a1").End(xlToRight)) 'Select data by the maximum row and maximum column of the title row
 
Total = UBound(myrange, 1) 'Get the number of rows
Fields = UBound(myrange, 2) 'Get the number of columns
 
   Dim objStream As Object
   Set objStream = CreateObject("")
   
   With objStream
      .Type = 2
      .Charset = "UTF-8"
      .Open
      .WriteText "{""total"":" & Total & ",""contents"":["
   
      For i = 2 To Total
        .WriteText "{"
        For j = 1 To Fields
          .WriteText """" & myrange(1, j) & """:""" & Replace(myrange(i, j), """", "\""") & """"
           If j <> Fields Then
            .WriteText ","
           End If
        Next
        If i = Total Then
            .WriteText "}"
        Else
            .WriteText "},"
        End If
      Next
 
      .WriteText "]}"
      .SaveToFile  & ".json", 2
   End With
   Set objStream = Nothing
End Sub

Recently, I am writing a website web page. I need to return the MYSQL record set queried from the background ASP web page to the front-end ASP web page. We know that AJAX is unable to return the database record set from the background to the front-end web page.

Looking up a lot of information, at present, converting the record set into JSON format stream, and then importing excel from the front-end VBA to the WEBoffice control is a good choice. After some thought, I will devote the function process code to everyone.

    Function GetJSON(Rs)
    Dim JSON  
    dim returnStr 
    dim i
    dim oneRecord   
    if =false and =false then
    returnStr="{ "&chr(34)&"records"&chr(34)&":["    
    while =false
    
     for i=0 to  -1
      oneRecord=oneRecord & chr(34) & (i).Name & chr(34) &":" 
      oneRecord=oneRecord & chr(34) & (i).Value & chr(34) &","
     Next
     oneRecord=left(oneRecord,InStrRev(oneRecord,",")-1)
     oneRecord=oneRecord & "},"
     returnStr=returnStr  & oneRecord
     
    Wend
    returnStr=left(returnStr,InStrRev(returnStr,",")-1)
    returnStr=returnStr & "]}"
    end if 
    GetJSON=returnStr   
  End Function