我要投稿

VBA将excel数据表生成JSON文件

admin VBA

2023-12-05 0 262

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

您可能感兴趣的文章: