ADODB.Stream创建UTF-8+BOM编码的文本文件。
然后遍历数据区，格式化数据，输出即可。
小数据还行，大数据没测试。
另，使用fso创建的文本文件编码为ANSI，ajax解析json时出现乱码无法正常解析。
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过程代码奉献给大家.
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
您可能感兴趣的文章:- 用vba实现将记录集输出到Excel模板
- excel vba 限制工作表的滚动区域代码
- excel vba 高亮显示当前行代码
- Excel VBA连接并操作Oracle
- php 备份数据库代码(生成word,excel,json,xml,sql)
- VBA中操作Excel常用方法总结
- Node.js实现Excel转JSON
