JSON VBA Parse to Excel
16,712
Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
' Retrieve question #50068973 HTML content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://stackoverflow.com/questions/50068973", False
.send
sJSONString = .responseText
End With
' Extract JSON sample from the question
sJSONString = "{" & Split(sJSONString, "<code>{", 2)(1)
sJSONString = Split(sJSONString, "</code>", 2)(0)
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
End
End If
' Convert raw JSON to array and output to worksheet #1
JSON.ToArray vJSON, aData, aHeader
With Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
' Flatten JSON
JSON.Flatten vJSON, vResult
' Convert flattened JSON to array and output to worksheet #2
JSON.ToArray vResult, aData, aHeader
With Sheets(2)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
The output on the worksheet #1 for the raw sample you provided is as follows:
And there is the flattened sample output on the worksheet #2:
BTW, the similar approach applied in other answers.
Author by
Kai K
Updated on June 13, 2022Comments
-
Kai K almost 2 years
I got some JSON parsing working. I use VBA to parse a JSON code from my webserver, write that to cell A1 at my Excel Worksheet. But I don't get this to convert into the other cells.
Here is my JSON sample:
{ "@type":["IN.areaList.1","OII.list.1"], "@self":"/bereiche", "list":[ {"@type":["IN.bereich.1"], "@self":"/1.1.Bereich.2.7", "scha":false, "trlState":"", "oiischa":false, "readyTo1":false, "readyTo2":false, "numberOfBypassedDevices":0, "test":"", "TestActive":false, "chModeActive":false, "incs":[]} ] }
This is my Sub, it is working for another sample:
Sub JsonToExcelExample() Dim jsonText As String Dim jsonObject As Object Dim item As Object Dim i As Long Dim ws As Worksheet Set ws = Worksheets("Remote") jsonText = ws.Cells(1, 1) Set jsonObject = JsonConverter.ParseJson(jsonText) i = 3 ws.Cells(2, 1) = "Color" ws.Cells(2, 2) = "Hex Code" For Each item In jsonObject("0") ws.Cells(i, 1) = item("color") ws.Cells(i, 2) = item("value") i = i + 1 Next End Sub
How this VBA code should be changed so that the above JSON sample to be placed on the worksheet like a table?
-
Marius almost 5 yearsI found this to be very slow on large data sets. It looks like: "Output2DArray .Cells(2, 1), aData" is taking all the time. Any suggestions? I tried Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual
-
omegastripes almost 5 years@Marius AFAIK
Output2DArray
uses the fastest method available in VBA. -
Marius almost 5 yearsEdit to above comment: Apologies, it was actually JSON.Parse that takes all the time. Any way to speed it up?
-
omegastripes almost 5 years@Marius IMO better you to post a new question where you can describe the performance issue you encountered.