VBA將excel數(shù)據(jù)表生成JSON文件

更新時間：2015年09月14日 08:55:51 投稿：hebedich

本文給大家匯總介紹了幾種使用VBA處理EXCEL并生成JSON文件的方法和思路，非常的實用，有需要的小伙伴可以參考下。

ADODB.Stream創(chuàng)建UTF-8+BOM編碼的文本文件。

然后遍歷數(shù)據(jù)區(qū)，格式化數(shù)據(jù)，輸出即可。

小數(shù)據(jù)還行，大數(shù)據(jù)沒測試。

另，使用fso創(chuàng)建的文本文件編碼為ANSI，ajax解析json時出現(xiàn)亂碼無法正常解析。

Sub ToJson() '創(chuàng)建UTF8文本文件
 myrange = Worksheets("sheet1").UsedRange '通過有效數(shù)據(jù)區(qū)來選擇數(shù)據(jù)
 'myrange = ActiveWorkbook.Names("schoolinfo").RefersToRange '通過定義的名稱來選擇數(shù)據(jù)
 'myrange = Range(Worksheets("sheet1").Range("a1").End(xlDown), Worksheets("sheet1").Range("a1").End(xlToRight)) '通過標題行的最大行最大列來選擇數(shù)據(jù)
 
Total = UBound(myrange, 1) '獲取行數(shù)
Fields = UBound(myrange, 2) '獲取列數(shù)
 
   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

最近在寫一網(wǎng)站網(wǎng)頁,需要從后臺ASP網(wǎng)頁查詢到的MYSQL記錄集返回給前臺ASP網(wǎng)頁,我們知道AJAX是無力從后臺返回數(shù)據(jù)庫記錄集給前臺網(wǎng)頁的.

查閱大量資料,就目前而言記錄集轉(zhuǎn)換成JSON格式流,再由前臺VBA導(dǎo)入WEBoffice控件的excel是個不錯的選擇.經(jīng)過些思考,現(xiàn)將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

您可能感興趣的文章: