Parse JSON with Excel VBA

[Ferdi24]

Hi Experts,

I'm trying to parse a JSON string in Excel VBA into an array so that I can write it in table-format into a sheet.

Example: I have this JSON string in cell A1 "rows":[["20120604", "ABC", "89"],["20120604", "BCD", "120"],["20120604", "CDE","239"]]

The final result in my sheet should look like this:

20120604 | ABC | 89
20120604 | BCD | 20
20120604 | CDE | 239

The format of the content inbetween the [ ] could be anything.

Example 1:
"rows":[["20120604","122"],["20120604","239"],["20120604","150"]]
Example2:
"rows":[["ABC","34"],["BCD","111"],["CDE","459"]]
Example3:
"rows":[["20120604", "ABC", "89"],["20120604", "BCD", "120"],["20120604", "CDE","239"]]
Example4:
"rows":[["XYZ", "ABC", "89","15"],["WXY", "BCD", "120","11"],["VWX", "CDE","239","19"]]

Does anyone have any ideas and would be willing to share his/her wisdom ith me?
Thanks a lot for reading

 

[Juan Pablo González]

I'm using this:

http://www.ediy.co.nz/vbjson-json-parser-library-in-vb6-xidc55680.html

And has been working great.

 

[Ferdi24]

Hi Juan,
Thanks for the link. I have found this before, but I am not sure how I can ues this to convert JSON to the desired format of a table.
Do you know if there is a tutorial or s.th. avaiable around this? Or if it's not too complicated to explain, do you have any hint what exactly I would need to do?

 

[Ferdi24]

Or maybe anyone else would have any additional ideas? Or could help me out with what Juan suggested?

 

[Juan Pablo González]

You need to import the "JSON.bas", "cJSONScript.cls" and "cStringBuilder.cls" to your project.

Go to Tools | References and add a reference to the "Microsoft Scripting Runtime" library and to the "Microsoft ActiveX Data Objects 2.8 Library" library.

Now, the text that you have in A1 is not a real JSON object, so we need to trick it in the code a little bit (By enclosing it in {} ).

Sub Test()
    Dim jsonText As String
    Dim jsonObj As Dictionary
    Dim jsonRows As Collection
    Dim jsonRow As Collection
    Dim ws As Worksheet
    Dim currentRow As Long
    Dim startColumn As Long
    Dim i As Long
    
    Set ws = Worksheets("Sheet1")
    
    'Create a real JSON object
    jsonText = "{" & ws.Range("A1").Value & "}"
    
    'Parse it
    Set jsonObj = JSON.parse(jsonText)
    
    'Get the rows collection
    Set jsonRows = jsonObj("rows")
    
    'Set the starting row where to put the values
    currentRow = 1
    
    'First column where to put the values
    startColumn = 2 'B
    
    'Loop through all the values received
    For Each jsonRow In jsonRows
        'Now loop through all the items in this row
        For i = 1 To jsonRow.Count
            ws.Cells(currentRow, startColumn + i - 1).Value = jsonRow(i)
        Next i
        
        'Increment the row to the next one
        currentRow = currentRow + 1
    Next jsonRow
End Sub

 

[Ferdi24]

That works brilliantly, Juan, you cannot imagine how happy I am with this.
And it is so simple! You have just ended my 2 week long project.

Thank you very much, it's nice to find people on the internet willing to help others.
I appreciate you taking the time.

Hopefully this can also be a reference for others, too, as I was really struggling to find something people like me can understand.

Thanks!

 

[jgandalf]

Hi Juan,

I am really glad to have found this thread, as I am trying to do the exact same thing.

However, I am a newbie to Excel VBA, and I can't get it to work.

Following line gives me a "Type missmatch" error:

For Each jsonRow In jsonRows

Doesn't "jsonRow" need to be assigned a value somewhere?

Many thanks,
Johan

 

[jgandalf]

Here is an example of the JSON that I would like to parse. This one contains 4 rows and 19 columns.

{"schedules":[{"summary":"Sign in","executedOn":"10/Oct/12 1:50 PM","cycleName":"asdf","cycleID":15,"label":"1, 2, 3, 4, 5","issueId":123,"versionName":"asdf","issueID":123,"defects":[{"key":"124","status":"Closed","summary":"Title"},{"key":"asdf","status":"Closed","summary":"asdfasdf"}],"executedByDisplay":"Name of person","executionStatus":"2","htmlComment":"asdfasd","projectID":"asdf","executedBy":"asdasg","component":"","versionID":"adasd","issueKey":"asdf","scheduleID":73,"comment":"adsfasdf"},{"summary":"asdf","executedOn":"10/Oct/12 1:17 PM","cycleName":"asdf","cycleID":15,"label":"1, 2, 3, 4, 5, 6, 7, 89, 5, 34","issueId":10012,"versionName":"sdf","issueID":10012,"defects":[{"key":"asdf","asdf":"asdf","summary":"asdf"},{"key":"asdf","status":"Closed","summary":"asdf"}],"executedByDisplay":"asdf","executionStatus":"2","htmlComment":"asdf","projectID":10002,"executedBy":"asdf","component":"","versionID":10001,"issueKey":"Edf","scheduleID":18,"comment":"asdf"},{"summary":"asdf","executedOn":"10/Oct/12 1:20 PM","cycleName":"asdf","cycleID":15,"label":"1, 2","issueId":10011,"versionName":"asdf","issueID":10011,"defects":[{"key":"asdf","status":"Closed","summary":"asdf"},{"key":"asdf","status":"Closed","summary":"asdf - asdf"}],"executedByDisplay":"asdf","executionStatus":"2","htmlComment":"asdf","projectID":10002,"executedBy":"asdf","component":"","versionID":10001,"issueKey":"asdf","scheduleID":17,"comment":"asdf"},{"summary":"asdfasdf","executedOn":"10/Oct/12 1:26 PM","cycleName":"asdf","cycleID":15,"label":"1,2","issueId":10010,"versionName":"asdf","issueID":10010,"defects":[{"key":"asdf","status":"Closed","summary":"asdfa"},{"key":"asdf","status":"Closed","summary":"asdf"}],"executedByDisplay":"asdfasf","executionStatus":"2","htmlComment":"asdfafd","projectID":10002,"executedBy":"asdf","component":"","versionID":10001,"issueKey":"afgaf","scheduleID":16,"comment":"asdf"}]}

Any ideas would be greatly appreciated!

 

[rhildreth]

I'm using Office 2013 and am getting a "type mismatch" for StrPtr in all cases of UnsignedAdd like this one in cStringBuilder:

lPos = UnsignedAdd(StrPtr(m_sString), iIndex * 2)

This is running 64 bit which seems to be the cause but not sure of the fix. Thanks. Ron

 

[rhildreth]

found fix here: Issue 13 - vba-json - here's an update for office 64-bit support - json parser for VBA - Google Project Hosting