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
    

发表评论

发表评论