excel通過vbs導出json文件

原創

猫叔压力大

2019-01-19 22:51

朋友怎麼把excel數據導成json，就去研究了一番。

晚上找到的一段vba代碼有2個問題一個是不能修改標籤頁的名字，一個是存儲的json文件明帶上了.xlsm的後綴。

修改後發上來。

一、excel 2007 創建能使用宏的xlsm文件

Sub ToJson() '創建UTF8文本文件
 myrange = Worksheets(ActiveSheet.Name).UsedRange  '通過有效數據區來選擇數據   ActiveSheet.Name當前sheet標籤的名字
 '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.Path & "/" & ActiveSheet.Name & ".json", 2
     End With
     Set objStream = Nothing
End Sub

完整代碼如上，