VBA excelデータテーブルをJSONファイルに生成
3038 ワード
ADODB.StreamはUTF-8+BOMコードのテキストファイルを作成します.
その後、データ領域を巡り、データをフォーマットし、出力すればいいです.
小さいデータはまあまあですが、大きなデータはテストされていません.
また、fsoで作成したテキストファイルはANSIとして符号化され、ajaxでjsonを解析中に文字化けして正常に解析できない.
最近ウェブサイトのホームページを书いて、バックグラウンドのASPのホームページから调べたMYSQLの记录集がフロントのASPのホームページに戻る必要があって、私达はAJAXがバックグラウンドからデータベースの记录集をフロントのホームページに返す力がないことを知っています.
大量の資料を調べて、現在のところ記録集をJSON形式のストリームに変換して、更にフロントVBAからWEBofficeコントロールのexcelを導入するのは悪くない選択です.いくつかの思考を経て、functionプロセスコードを皆さんに捧げます.
その後、データ領域を巡り、データをフォーマットし、出力すればいいです.
小さいデータはまあまあですが、大きなデータはテストされていません.
また、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