VBA将excel数据表生成JSON文件
ADODB.Stream创建UTF-8+BOM编码的文本文件。
然后遍历数据区，格式化数据，输出即可。
小数据还行，大数据没测试。
另，使用fso创建的文本文件编码为ANSI，ajax解析json时出现乱码无法正常解析。
SubToJson()'创建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)'获取列数
DimobjStreamAsObject
SetobjStream=CreateObject("ADODB.Stream")
WithobjStream
.Type=2
.Charset="UTF-8"
.Open
.WriteText"{""total"":"&Total&",""contents"":["
Fori=2ToTotal
.WriteText"{"
Forj=1ToFields
.WriteText""""&myrange(1,j)&""":"""&Replace(myrange(i,j),"""","\""")&""""
Ifj<>FieldsThen
.WriteText","
EndIf
Next
Ifi=TotalThen
.WriteText"}"
Else
.WriteText"},"
EndIf
Next
.WriteText"]}"
.SaveToFileActiveWorkbook.FullName&".json",2
EndWith
SetobjStream=Nothing
EndSub
最近在写一网站网页,需要从后台ASP网页查询到的MYSQL记录集返回给前台ASP网页,我们知道AJAX是无力从后台返回数据库记录集给前台网页的.
查阅大量资料,就目前而言记录集转换成JSON格式流,再由前台VBA导入WEBoffice控件的excel是个不错的选择.经过些思考,现将function过程代码奉献给大家.
FunctionGetJSON(Rs)
DimJSON
dimreturnStr
dimi
dimoneRecord
ifRs.eof=falseandRs.Bof=falsethen
returnStr="{"&chr(34)&"records"&chr(34)&":["
whileRs.eof=false
fori=0toRs.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&"]}"
endif
GetJSON=returnStr
EndFunction