VBA Parse Nested JSON

Question

VBA Noob here. Please excuse any gaps in terminology etc.

I am trying to parse a JSON file into a spreadsheet using VBA-JSON v2.2.3 (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON.

The JSON file looks like this:

{
  "site": "{5BEC7C29-FF95-4ECC-9314-064B52618EEE}",
  "from": "2017-01-16",
  "to": "2017-01-22",
  "timeSheet": [
    {
      "date": "2017-01-16",
      "person": "{E2A5FDE1-33F8-43CA-A01D-5DD4A3A5E23A}",
      "personName": "James Smith",
      "company": "{B03CF7B3-0BE9-44B4-8E55-47782FDD87C0}",
      "companyName": "Acme Company Ltd",
      "minutes": "510",
      "activities": [
        {
          "name": "Training",
          "code": "TR",
          "minutes": "240"
        },
        {
          "name": "Administration",
          "code": "AD",
          "minutes": "150"
        },
        {
          "name": "Payroll",
          "code": "PR",
          "minutes": "60"
        },
        {
          "name": "Meal break",
          "code": "",
          "minutes": "60"
        }
      ]
    }
  ]
}

There may be any number of 'timeSheet' records, as well as any number of 'Activities' within each timeSheet including zero.

I want a row in the spreadsheet for each activity, with the name and other data outputted next to that days activities. Essentially showing a log of all the activities done, for how long and by who. To complicate issues, I still need the name etc outputting even if no activities are recorded. I will then fill with 'unallocated time' or something similar.

Below is as far as I have got (abridged), with an updated count of the activities occurring every loop. This feels a little hacky and doesn't give me what I am looking for, often adding additional rows and sometimes missing activities entirely.

i = 2
j = 1
activCount = CStr(JSON("timeSheet")(1)("activities").Count)

If activCount = 0 Then activCount = 1

    ws.Cells(i, 1) = JSON("site")
    ws.Cells(i, 2) = JSON("from")
    ws.Cells(i, 3) = JSON("to")


For Each item In JSON("timeSheet")
    For j = 1 To activCount
        On Error Resume Next
        ws.Cells(i, 4) = item("date")
        ws.Cells(i, 5) = item("personName")
        ws.Cells(i, 6) = item("companyName")
        ws.Cells(i, 7) = item("minutes")
        ws.Cells(i, 9) = item("activities")(j)("name")
        ws.Cells(i, 10) = item("activities")(j)("code")
        ws.Cells(i, 11) = item("activities")(j)("minutes")

        activCount = CStr(JSON("timeSheet")(i)("activities").Count)
        If activCount = 0 Then activCount = 1
        i = i + 1

    Next
Next

Can someone help? I have run out of ideas and have been working it for some time! Thank you. :)

Welcome to Stack Overflow! ...I'm sorry but if you're a self-declared VBA Noob, this ancient, half-working VBA-JSON module is pretty much the worst place to begin. Believe me, I've wasted a lot of time on it. — ashleedawg
– ashleedawg, Commented Feb 26, 2018 at 3:29
If the JSON file is that small, you should be able to parse it without issue using text functions (mainly InStr and Mid, or else RegEx). There's a lot of examples around. Sadly, JSON and VBA don't get along too well. — ashleedawg
– ashleedawg, Commented Feb 26, 2018 at 3:30
@ashleedawg - I've never had an issue with that module: care to share some specifics around why you recommend against it? — Tim Williams
– Tim Williams, Commented Feb 26, 2018 at 3:42
@Tim - I've never not had an issue. It could be partially related to the fact that the JSON sources I've needed to work with are extremely large, also in the real world, files aren't always gonna be 100% perfect structure, but these kinds of things shouldn't be such a problem with data coming from well-known sources such as Google or NAVCAN. (Equally frustrating for me are Office's supposed built-in JSON / XML tools, which work great - except for when they don't.) I up building my own JSON import utility, which even built half-cocked, still does it's job better than the others. — ashleedawg
– ashleedawg, Commented Feb 26, 2018 at 3:51

Tim Williams · Accepted Answer · 2018-02-26 04:42:08Z

0

This worked fine for me:

Sub TestJson2()

    Dim ts, act
    Dim Json As Object, c As Range

    'reading json from a worksheet cell...
    Set Json = JsonConverter.ParseJson(Range("A3").Value)

    Set c = ActiveSheet.Range("C5")

    'loop over timesheets
    For Each ts In Json("timeSheet")
        'loop over timesheet activities
        For Each act In ts("activities")

            c.Resize(1, 11).Value = Array(Json("site"), Json("from"), Json("to"), _
                                       ts("date"), ts("personName"), ts("companyName"), _
                                       ts("minutes"), act("name"), act("code"), _
                                       act("minutes"))
            Set c = c.Offset(1, 0)
        Next act
    Next ts

End Sub

edited Feb 26, 2018 at 4:42

answered Feb 26, 2018 at 4:36

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

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

2 Comments

Alonso Keef Over a year ago

Thanks Tim! I will have a look at implementing this later today and feedback how it goes.

Alonso Keef Over a year ago

Finally had a chance to get back to this project. Unfortunately the above solution doesn't work as it only outputs records with an activity attached. This isn't always the case.

Collectives™ on Stack Overflow

VBA Parse Nested JSON

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related