VBA将excel数据表生成JSON文件

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