Error parsing json excel vba

Question

I am using the jsonConverter.bas file from here https://github.com/VBA-tools/VBA-JSON.

When parsing json file most of the files are successfully parsed but there is issue with one file which returns Error Parsing JSON.

Here is the json file if anyone is interested: http://s000.tinyupload.com/index.php?file_id=45560953732509718973

Error parsing JSON: ï»¿{ "star ^ Expecting '{' or '['

Along with the JsonConverter.bas file I am using below sub:

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

Dy.Lee · Accepted Answer

Your json file is encoded by UTF-8. So it did not work. convert encoding utf-8 by this.

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

After converting, run your code.

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

Error parsing json excel vba

Answers (1)

Related Questions