错误parsingjson excel vba
我从这里使用jsonConverter.bas文件https://github.com/VBA-tools/VBA-JSON 。
当parsingjson文件时，大部分文件都被成功的parsing了，但是有一个文件返回Error Parsing JSON 。
这里是json文件，如果有人感兴趣： http ://s000.tinyupload.com/index.php?file_id=45560953732509718973
parsingJSON时出错：{“star”期待'{'或'['
随着JsonConverter.bas文件我使用下面的子：
Option Explicit Dim myPath As String, myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim fD As Long, fColD As Long Dim cet Sub getDataFromJSON() Application.ScreenUpdating = False: Application.EnableEvents = False: Application.Calculation = xlCalculationManual Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings myExtension = "*.json" myFile = Dir(myPath & myExtension) Do While myFile <> "" Call getData myFile = Dir Loop Data.Activate MsgBox "Task Complete!" ResetSettings: Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True End Sub Sub getData() ' Advanced example: Read .json file and load into sheet (Windows-only) ' (add reference to Microsoft Scripting Runtime) ' {"values":[{"a":1,"b":2,"c": 3},...]} Dim FSO As New FileSystemObject Dim JsonTS As TextStream, JsonText As String, Parsed As Dictionary Set JsonTS = FSO.OpenTextFile(myPath & myFile, ForReading) JsonText = JsonTS.ReadAll JsonTS.Close Set Parsed = JsonConverter.ParseJson(JsonText) ' Prepare and write values to sheet Dim Value As Dictionary With Data fD = .Range("A" & .Rows.Count).End(xlUp).Row + 1 fColD = 34 For Each Value In Parsed("events") .Cells(fD, fColD) = Value("t") .Cells(fD, fColD + 1) = Value("e") .Cells(fD, fColD + 2) = Value("ty") .Cells(fD, fColD + 3) = Value("x") .Cells(fD, fColD + 4) = Value("y") fColD = fColD + 5 Next Value .Range("A" & fD) = Parsed("startTime") .Range("B" & fD) = Parsed("websitePageUrl") .Range("C" & fD) = Parsed("session")("visitorId") .Range("D" & fD) = Parsed("session")("playbackUrl") .Range("E" & fD) = Parsed("visitTime") .Range("F" & fD) = Parsed("engagementTime") .Range("G" & fD) = Parsed("pageTitle") .Range("H" & fD) = Parsed("url") .Range("I" & fD) = Parsed("viewportWidth") .Range("J" & fD) = Parsed("viewportHeight") .Range("K" & fD) = Parsed("session")("id") .Range("L" & fD) = Parsed("session")("created") .Range("M" & fD) = Parsed("session")("lastActivity") .Range("N" & fD) = Parsed("session")("duration") .Range("O" & fD) = Parsed("session")("pages") .Range("P" & fD) = Parsed("session")("country") .Range("Q" & fD) = Parsed("session")("city") .Range("R" & fD) = Parsed("session")("isp") .Range("S" & fD) = Parsed("session")("lang") .Range("T" & fD) = Parsed("session")("userAgent") .Range("U" & fD) = Parsed("session")("browser") .Range("V" & fD) = Parsed("session")("browserVersion") .Range("W" & fD) = Parsed("session")("os") .Range("X" & fD) = Parsed("session")("osVersion") .Range("Y" & fD) = Parsed("session")("device") .Range("Z" & fD) = Parsed("session")("referrer") .Range("AA" & fD) = Parsed("session")("referrerType") .Range("AB" & fD) = Parsed("session")("screenRes") .Range("AC" & fD) = Parsed("session")("entryPage") 'loadtimes cet = Split(Parsed("loadTimes"), ",") .Range("AD" & fD) = Trim(Split(cet(0), ":")(1)) .Range("AE" & fD) = Trim(Split(cet(1), ":")(1)) .Range("AF" & fD) = Trim(Split(cet(2), ":")(1)) .Range("AG" & fD) = Trim(Split(cet(3), ":")(1)) End With End Sub
你的json文件是由UTF-8编码的。 所以它没有工作。 通过这个转换编码utf-8。
Function getString(path As String) Dim objStream As Object Set objStream = CreateObject("ADODB.Stream") With objStream .Charset = "UTF-8" .Open .LoadFromFile path getString = .readtext .Close End With Set objStream = Nothing End Function
转换后，运行你的代码。
Dim myPath As String, myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim fD As Long, fColD As Long Dim cet Sub getDataFromJSON() Application.ScreenUpdating = False: Application.EnableEvents = False: Application.Calculation = xlCalculationManual Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings myExtension = "*.json" myFile = Dir(myPath & myExtension) Do While myFile <> "" Call getData myFile = Dir Loop 'Data.Activate MsgBox "Task Complete!" ResetSettings: Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True End Sub Sub getData() ' Advanced example: Read .json file and load into sheet (Windows-only) ' (add reference to Microsoft Scripting Runtime) ' {"values":[{"a":1,"b":2,"c": 3},...]} Dim FSO As New FileSystemObject Dim JsonTS As TextStream, JsonText As String, Parsed As Dictionary 'Set JsonTS = FSO.OpenTextFile(myPath & myFile, ForReading) 'JsonText = JsonTS.ReadAll 'JsonTS.Close JsonText = getString(myPath & myFile) '<~~ convert utf-8 encode Set Parsed = JsonConverter.ParseJson(JsonText) ' Prepare and write values to sheet Dim Value As Dictionary 'With Data With ActiveSheet fD = .Range("A" & .Rows.Count).End(xlUp).Row + 1 fColD = 34 For Each Value In Parsed("events") .Cells(fD, fColD) = Value("t") .Cells(fD, fColD + 1) = Value("e") .Cells(fD, fColD + 2) = Value("ty") .Cells(fD, fColD + 3) = Value("x") .Cells(fD, fColD + 4) = Value("y") fColD = fColD + 5 Next Value .Range("A" & fD) = Parsed("startTime") .Range("B" & fD) = Parsed("websitePageUrl") .Range("C" & fD) = Parsed("session")("visitorId") .Range("D" & fD) = Parsed("session")("playbackUrl") .Range("E" & fD) = Parsed("visitTime") .Range("F" & fD) = Parsed("engagementTime") .Range("G" & fD) = Parsed("pageTitle") .Range("H" & fD) = Parsed("url") .Range("I" & fD) = Parsed("viewportWidth") .Range("J" & fD) = Parsed("viewportHeight") .Range("K" & fD) = Parsed("session")("id") .Range("L" & fD) = Parsed("session")("created") .Range("M" & fD) = Parsed("session")("lastActivity") .Range("N" & fD) = Parsed("session")("duration") .Range("O" & fD) = Parsed("session")("pages") .Range("P" & fD) = Parsed("session")("country") .Range("Q" & fD) = Parsed("session")("city") .Range("R" & fD) = Parsed("session")("isp") .Range("S" & fD) = Parsed("session")("lang") .Range("T" & fD) = Parsed("session")("userAgent") .Range("U" & fD) = Parsed("session")("browser") .Range("V" & fD) = Parsed("session")("browserVersion") .Range("W" & fD) = Parsed("session")("os") .Range("X" & fD) = Parsed("session")("osVersion") .Range("Y" & fD) = Parsed("session")("device") .Range("Z" & fD) = Parsed("session")("referrer") .Range("AA" & fD) = Parsed("session")("referrerType") .Range("AB" & fD) = Parsed("session")("screenRes") .Range("AC" & fD) = Parsed("session")("entryPage") 'loadtimes cet = Split(Parsed("loadTimes"), ",") .Range("AD" & fD) = Trim(Split(cet(0), ":")(1)) .Range("AE" & fD) = Trim(Split(cet(1), ":")(1)) .Range("AF" & fD) = Trim(Split(cet(2), ":")(1)) .Range("AG" & fD) = Trim(Split(cet(3), ":")(1)) End With End Sub Function getString(path As String) Dim objStream As Object Set objStream = CreateObject("ADODB.Stream") With objStream .Charset = "UTF-8" .Open .LoadFromFile path getString = .readtext .Close End With Set objStream = Nothing End Function