VBA将excel数据表生成JSON文件

ADODB.Stream创建UTF-8+BOM编码的文本文件。

然后遍历数据区，格式化数据，输出即可。

小数据还行，大数据没测试。

另，使用fso创建的文本文件编码为ANSI，ajax解析json时出现乱码无法正常解析。

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

Sub ToJson() '创建UTF8文本文件  myrange = Worksheets("sheet1").UsedRange '通过有效数据区来选择数据  'myrange = ActiveWorkbook.Names("schoolinfo").RefersToRange '通过定义的名称来选择数据  'myrange = Range(Worksheets("sheet1").Range("a1").End(xlDown), Worksheets("sheet1").Range("a1").End(xlToRight)) '通过标题行的最大行最大列来选择数据    Total = UBound(myrange, 1) '获取行数 Fields = UBound(myrange, 2) '获取列数       Dim objStream As Object    Set objStream = CreateObject("ADODB.Stream")         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 ActiveWorkbook.FullName & ".json", 2    End With    Set objStream = Nothing End Sub

最近在写一网站网页,需要从后台ASP网页查询到的MYSQL记录集返回给前台ASP网页,我们知道AJAX是无力从后台返回数据库记录集给前台网页的.

查阅大量资料,就目前而言记录集转换成JSON格式流,再由前台VBA导入WEBoffice控件的excel是个不错的选择.经过些思考,现将function过程代码奉献给大家.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

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