JSON Data and Microsoft Access VBA

A common request is to interact with APIs of various platforms via JSON data structures. A great resource for this is Tim Hall’s VBA-JSON library

The below sample VBA code references Microsoft’s MSXML2.XMLHTTP60 . A sample call (in this case to the Egnyte API) is:

Dim xmlhttp As New MSXML2.XMLHTTP60

Dim JSON As Object

xmlhttp.Open “GET”, “https://testsite.egnyte.com/pubapi/v1/fs/FolderName? list_custom_metadata=true”, False, UserName, Password

xmlhttp.setRequestHeader “Host”, “testsite.egnyte.com”

xmlhttp.setRequestHeader “Content-Type”, “application/json”

xmlhttp.setRequestHeader “Connection”, “Close”

xmlhttp.setRequestHeader “Authorization”, “Bearer Token

xmlhttp.send

Set JSON = JsonConverter.ParseJson(xmlhttp.responseText)

Once you have the JSON object/data, you can either simply access elements directly using the functions in the VBA-JSON
library (follow the above link to see examples) or traverse the structure to dynamically read the structure. The below example is reading Egnyte file attributes.

    Dim Parsed As Dictionary

    Dim initialCollection  As Collection

    Set initialCollection = json(“files”) ‘upper parent node of returned JSON structure

    Dim initialDict As Dictionary

    Dim Key, fileKey As Variant

    Dim dataStructure As String

    iFileCnt = 1

        Do Until iFileCnt = CInt(json(“files”).Count) + 1

            Set initialDict = initialCollection(iFileCnt)

            For Each Key In initialDict.keys

                dataStructure = TypeName(initialDict(Key))

                Select Case dataStructure

                       Case “String”, “Boolean”, “Double”

                            If Key = “name” Then

                               sFileName = initialDict(Key)

                            End If

                            If Key = “last_modified” Then

                               sFileDate = initialDict(Key)

                            End If

                       Case “Collection”

                            Dim Key4 As Variant

                            Dim Key5 As Variant

                            Dim iKeyCnt As Integer

                            iKeyCnt = 1

                            If initialDict(Key).Count > 0 Then ‘There is 1 or more tags/keys

                               Do Until iKeyCnt = initialDict(Key).Count + 1

                                  For Each Key4 In initialDict(Key)(iKeyCnt).keys

                                      Select Case Key4

                                         Case “location”:

                         For Each Key5 In initialDict(Key)(iKeyCnt)(Key4).keys

                                             Select Case Key5

                                               Case “city”

                                               sCity = initialDict(Key)(iKeyCnt)(Key4)(Key5)

                                               Case “state”

                                                sState = initialDict(Key)(iKeyCnt)(Key4)(Key5)

                                                      End Select

                                                  Next Key5

                                      End Select

                                  Next Key4

                                  iKeyCnt = iKeyCnt + 1

                               Loop

                            End If

                       Case Else

                            MsgBox “Key missed in JSON parsing.”

                End Select

            Next Key

            iFileCnt = iFileCnt + 1

        Loop