- 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
来源: http://www.phpxs.com/code/1008746/