VBA将excel数据表生成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 = NothingEnd Sub

    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