Parsing JSON to Excel using VBA

Question

I'm having some trouble with parsing JSON data in VBA. I have tried all of the examples online but I'm still unable to solve the issue. What I have managed to do is pull the JSON data into excel in the original format using another VBA code that pulled in data from another website. I've pasted the code that works below. It's not very clean and it has some duplication because I was just trying to see if I could pull the data. All of the attempts I have tried to use VBA to parse the data have failed with a variety of errors depending on the approach I took. I'd be very grateful if someone could give me some advice on the simplest way to parse the data I've managed to pull. All I need is the data in columns which I can then use in other sheets in the worbook. I've attached a picture of the data that I've pulled. I have managed to parse JSON data from another webpage and in the code I included each column heading for the JSON data. For this new webpage, the JSON data is nested and there are loads of unique rows so I've not taken this approach. Many thanks

[Sub JSONPull()
Dim WB As Workbook, ws As Worksheet, ws2 As Worksheet, qtb As QueryTable
Dim FC As String, sDate As String, eDate As String, Dockmasterurl As String, Performance As Worksheet

Set WB = Application.ThisWorkbook
Set ws = WB.Sheets("Control")

FC = ws.Range("B5")
sDate = ws.Range("B14")
eDate = ws.Range("B15")
Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

Dockmasterurl = "https://fc-inbound-dock-execution-service-eu-eug1-dub.dub.proxy.amazon.com/appointment/bySearchParams?warehouseId=" & FC & "&clientId=dockmaster&localStartDate=" & sDate & "T00%3A00%3A00&localEndDate=" & eDate & "T08%3A00%3A00&isStartInRange=false&searchResultLevel=FULL"

Set ws2 = Sheets("JSON")
ws2.Cells.ClearContents

Set qtb = ws2.QueryTables.Add("URL;" & Dockmasterurl, ws2.Range("A1"))
With qtb
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = True
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

ws2.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, textqualifier:=xlDoubleQuote, consecutivedelimiter:=False, comma:=True, trailingminusnumbers:=True
ws2.Range("A:S").EntireColumn.AutoFit

For Each qtb In ws2.QueryTables
    qtb.Delete

Next

End Sub][1]

You've not included any screenshot of your JSON. We'd need at least that or a working URL, or a sample of your JSON pasted as text. The best way to parse JSON in VBA is to use (eg) github.com/VBA-tools/VBA-JSON There are plenty of examples of using that here on SO alone. See stackoverflow.com/search?q=vba-json I would recommend trying out that approach, and if you run into problems post back with your code and a description of exactly what's going wrong when you run your code. — Tim Williams
– Tim Williams, Commented Aug 25, 2019 at 20:12
sample of json as text and link to pastebin of full json if possible (external links generally frowned upon - at own risk if people use) — QHarr
– QHarr, Commented Aug 25, 2019 at 20:21
Thanks for your replies. I've pasted the full JSON here: pastebin.com/hA2UEDXy I've tried using the github tool and get Runtime Error 424 object required on line : ReDim Values(Parsed("values").Count, 3) — Chris
– Chris, Commented Aug 25, 2019 at 20:53
Not to derail things, but have you considered using Power Query for this? (I think it's been a part of Excel on Windows since Excel 2013). It supports GET requests and JSON and you can (to some degree) visually explore/navigate the deserialised response. It will likely load the transformed/accumulated result as a table though (which you can refresh in the future). — chillin
– chillin, Commented Aug 25, 2019 at 21:08
Yes I've tried using power query but I've been unable to get the required data into columns, which I think may be due to the nested JSON data and the high number of unique rows. — Chris
– Chris, Commented Aug 25, 2019 at 21:21

omegastripes · Accepted Answer · 2019-08-25 23:32:36Z

3

Here is VBA example showing how the JSON sample by the link can be converted to 2D array and output to worksheet. 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()

    ' Retrieve JSON content
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://pastebin.com/raw/hA2UEDXy", True
        .send
        Do Until .readyState = 4: DoEvents: Loop
        sJSONString = .responseText
    End With
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then MsgBox "Invalid JSON": End
    ' Convert JSON to 2D Array
    JSON.ToArray vJSON("AppointmentList"), aData, aHeader
    ' Output to worksheet #1
    Output aHeader, aData, ThisWorkbook.Sheets(1)
    MsgBox "Completed"

End Sub

Sub Output(aHeader, aData, oDestWorksheet As Worksheet)

    With oDestWorksheet
        .Activate
        .Cells.Delete
        With .Cells(1, 1)
            .Resize(1, UBound(aHeader) - LBound(aHeader) + 1).Value = aHeader
            .Offset(1, 0).Resize( _
                    UBound(aData, 1) - LBound(aData, 1) + 1, _
                    UBound(aData, 2) - LBound(aData, 2) + 1 _
                ).Value = aData
        End With
        .Columns.AutoFit
    End With

End Sub

The output for me is as follows (click to enlarge):

BTW, the similar approach applied in other answers.

answered Aug 25, 2019 at 23:32

omegastripes

12.6k4 gold badges52 silver badges105 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

QHarr Over a year ago

what on earth is going on in the parser that the module code above can be so concise?! +

user3874805 · Accepted Answer · 2024-10-05 01:44:51Z

Sub JSONtoCSV()
Dim JsonText As String
Dim JsonObject As Object
Dim FSO As Object
Dim JsonFile As Object
Dim key As Variant
Dim item As Object
Dim row As Long
Dim col As Long
Dim headers As New Collection
Dim header As Variant
Dim ws As Worksheet

' Set the worksheet where data will be written
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your sheet name

' Read JSON file
Set FSO = CreateObject("Scripting.FileSystemObject")
Set JsonFile = FSO.OpenTextFile("C:\path\to\your\file.json", 1) ' 1 = ForReading
JsonText = JsonFile.ReadAll
JsonFile.Close

' Parse JSON
Set JsonObject = JsonConverter.ParseJson(JsonText)

' Initialize row and column counters
row = 1
col = 1

' Get headers from the first JSON object
For Each item In JsonObject
    For Each key In item.Keys
        On Error Resume Next
        headers.Add key, key
        On Error GoTo 0
    Next key
Next item

' Write headers to Excel sheet
For Each header In headers
    ws.Cells(row, col).Value = header
    col = col + 1
Next header

' Reset column counter and increment row counter
col = 1
row = row + 1

' Write data to Excel sheet
For Each item In JsonObject
    For Each header In headers
        If item.Exists(header) Then
            ws.Cells(row, col).Value = item(header)
        Else
            ws.Cells(row, col).Value = ""
        End If
        col = col + 1
    Next header
    col = 1
    row = row + 1
Next item

' Autofit columns for better visibility
ws.Columns.AutoFit

MsgBox "JSON data has been imported to Excel."

End Sub

Please describe your posted code. What is different to the already postet answer? Your code is missing code or a link to the used external reference/module/code

Collectives™ on Stack Overflow

Parsing JSON to Excel using VBA

2 Answers 2

1 Comment

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related