欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

VBA将excel数据表生成JSON文件

程序员文章站 2022-06-27 13:58:22
adodb.stream创建utf-8+bom编码的文本文件。 然后遍历数据区,格式化数据,输出即可。 小数据还行,大数据没测试。 另,使用fso创建的文本文件编码为...

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

相关标签: excel vba json