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 = NothingEnd 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新聞熱點
疑難解答
