JSON to Excel using VBA

[BilzR]

Hi all

I've been trying to do this for quite a while.

I've used VBA to hit their API to get data, which comes back in JSON format. I'm looking to convert JSON data to something more useful in excel, but so far have been struggling.

The JSON file is in this format:

[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]{"undeliverable_registered_office_address":false,"type":"ltd","date_of_creation":"1982-03-24","has_been_liquidated":false,"company_name":"MICROSOFT LIMITED","jurisdiction":"england-wales","accounts":{"last_accounts":{"period_end_on":"2016-06-30","type":"full","period_start_on":"2015-07-01","made_up_to":"2016-06-30"},"next_accounts":{"overdue":false,"period_start_on":"2016-07-01","due_on":"2018-03-31","period_end_on":"2017-06-30"},"overdue":false,"accounting_reference_date":{"day":"30","month":"06"},"next_made_up_to":"2017-06-30","next_due":"2018-03-31"},"company_number":"01624297","registered_office_address":{"address_line_1":"Microsoft Campus","region":"Berkshire","postal_code":"RG6 1WG","locality":"Reading","address_line_2":"Thames Valley Park"},"sic_codes":["62020"],"last_full_members_list_date":"2016-06-24","company_status":"active","has_insolvency_history":false,"etag":"a5fcd04e60c46c493e74bef23c8bef06f87d5827","has_charges":true,"previous_company_names":[{"name":"MICROSOFT EUROPE LIMITED","effective_from":"1982-05-25","ceased_on":"1983-06-16"},{"ceased_on":"1982-05-25","effective_from":"1982-03-24","name":"DIALMAIN LIMITED"}],"confirmation_statement":{"next_due":"2018-07-07","next_made_up_to":"2018-06-23","overdue":false,"last_made_up_to":"2017-06-23"},"links":{"self":"/company/01624297","filing_history":"/company/01624297/filing-history","officers":"/company/01624297/officers","charges":"/company/01624297/charges","persons_with_significant_control_statements":"/company/01624297/persons-with-significant-control-statements"},"registered_office_is_in_dispute":false,"can_file":true}[/TD]
[/TR]
</tbody>[/TABLE]

 

[rlv01]

Does it have to be VBA? Powershell will convert JSON to CSV.

https://stackoverflow.com/questions/43594860/convert-json-to-csv-using-powershell

 

[wideboydixon]

https://github.com/omegastripes/VBA-JSON-parser

WBD

 

[John_w]

Another JSON parser at https://www.mrexcel.com/forum/excel...url-import-parse-post5036313.html#post5036313 - the script and JSONobj lines.

 

[BilzR]

Unfortunately it has to be VBA.
Software restrictions at work.
I've installed the JSON VBA parser, but can't figure out the nested arrays and paste them in to Excel.

 

[John_w]

I've installed the JSON VBA parser, but can't figure out the nested arrays and paste them in to Excel.

The omegastripes JSON parser referenced above produces a structure of nested Dictionaries and arrays. A very nicely designed and written parser, although not the fastest because it uses RegExp and the Scripting.Dictionary libraries, and there is no documentation or examples showing how to use it. Because it uses Dictionaries and arrays, the code needed to access various parts of the data is straightforward, once you understand the structure of your particular JSON data.

Copy and paste the JSON.bas code into a standard VBA module (delete the first line "Attribute ...").

Put the following code in another module. It calls the JSON Parse routine on your data and shows how to access the nested Dictionaries and arrays, outputting the values to the Immediate window. It also includes the JSONToCells function which outputs the parsed JSON data to cells in a hierarchical format, with a comment in each value cell showing the 'path' to that data value. This 'path' relates directly to the VBA code needed to access that data value. The code reads the JSON data string from A1 of "Sheet1" and outputs the JSON data to a sheet named "JSON".

Public Sub Extract_JSON_Data()

    Dim JSONall As Variant
    Dim parseState As String
    Dim i As Long
            
    Parse ThisWorkbook.Worksheets("Sheet1").Range("A1").Value, JSONall, parseState
    If parseState = "Error" Then
        MsgBox "Error parsing JSON string"
        Exit Sub
    End If
    
    With ThisWorkbook.Worksheets("JSON")
        .Cells.Clear
        JSONToCells JSONall, .Range("A1")
    End With
        
    'Access company details
    Debug.Print JSONall("company_name")
    Debug.Print JSONall("date_of_creation")
    Debug.Print JSONall("company_number")
    
    'Access last accounts period end
    Debug.Print JSONall("accounts")("last_accounts")("period_end_on")

    'Another way to access last accounts
    Dim accounts As Variant
    Set accounts = JSONall("accounts")
    Set accounts = accounts("last_accounts")
    Debug.Print accounts("period_start_on")
    Debug.Print accounts("period_end_on")
    Debug.Print accounts("type")

    'Access SIC codes
    Debug.Print JSONall("sic_codes")("0")
    Dim SICcodes As Variant
    SICcodes = JSONall("sic_codes")
    For i = 0 To UBound(SICcodes)
        Debug.Print i; SICcodes(i)
    Next
    'Another way to loop through SIC codes
    For i = 0 To UBound(JSONall("sic_codes"))
        Debug.Print i; JSONall("sic_codes")(i)
    Next

    'Access previous company names details
    Dim previousNames As Variant
    previousNames = JSONall("previous_company_names")
    For i = 0 To UBound(previousNames)
        Debug.Print previousNames(i)("name")
        Debug.Print previousNames(i)("effective_from")
        Debug.Print previousNames(i)("ceased_on")
    Next
    'Another way to access previous company names details
    For i = 0 To UBound(JSONall("previous_company_names"))
        Debug.Print JSONall("previous_company_names")(i)("name")
        Debug.Print JSONall("previous_company_names")(i)("effective_from")
        Debug.Print JSONall("previous_company_names")(i)("ceased_on")
    Next
    
    'Access conf. statement details
    Debug.Print JSONall("confirmation_statement")("next_due")
    Debug.Print JSONall("confirmation_statement")("next_made_up_to")
    Debug.Print JSONall("confirmation_statement")("last_made_up_to")
    Debug.Print JSONall("confirmation_statement")("overdue")
        
End Sub


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long
    
    n = 0
    
    If VarType(JSONvar) = vbObject Then 'Dictionary
        
        For Each key In JSONvar.keys
            Debug.Print key
            destCell.Offset(n, 0).Value = key
            n = n + JSONToCells(JSONvar.item(key), destCell.Offset(n, 1), path & "(" & key & ")")
        Next
    
    ElseIf VarType(JSONvar) >= vbArray Then 'Variant()
                
        For i = 0 To UBound(JSONvar)
            Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next
        
    Else
        
        Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1
        
    End If

    JSONToCells = n
    
End Function


Private Sub CreateComment(cell As Range, commentText As String)
        
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
    
End Sub