We work with JSON a fair amount (and honestly I can’t say I care for it too much for anything outside of the JavaScript realm), and when it comes to VBA, there’s next to no support for it. Tim Hall has a great set of tools in his github repo, one in specific called VBA-JSON that tends to be a first hit when people have to go searching. I used this for a while myself, until I ran into a case that it fails on, which put me back on the drawing board.
The issue seems to be in the parsing algorithm used: some structures of valid JSON raise errors using the above code (see some examples here – and maybe watch the issue to see if there’s a fix at some point?). Furthermore, there’s a number of other “hand-made” parsers that seem to suffer the same faulty algorithm.
In any case, after numerous hours and at least a dozen different parsers being tested, I found the one that seems to work across the board. As well it should, is it’s tapping into the Microsoft JavaScript Engine to do the work. (credit to StackOverflow member Codo for the original source, as near as I can tell)
Toss the following into a standalone module. Following that is another code example for how to use this.
Module JsonParser:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
Option Compare Database Option Explicit Public Enum JsonPropertyType jptObject jptValue End Enum Private ScriptEngine As Object 'ScriptControl (ref: Microsoft Script Control 1.0) Public Sub InitScriptEngine() Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl") 'New ScriptControl ScriptEngine.Language = "JScript" ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } " ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } " End Sub Public Function DecodeJsonString(ByVal JSonString As String) Set DecodeJsonString = ScriptEngine.Eval("(" + JSonString + ")") End Function Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) 'As Variant GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName) End Function Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) 'As Object Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName) End Function Public Function GetPropertyType(ByVal JsonObject As Object, ByVal PropertyName As String) As JsonPropertyType On Error Resume Next Dim o As Object Set o = GetObjectProperty(JsonObject, PropertyName) If Err.Number Then GetPropertyType = jptValue Err.Clear On Error GoTo 0 Else GetPropertyType = jptObject End If End Function Public Function GetKeys(ByVal JsonObject As Object) As String() Dim Length As Integer Dim KeysArray() As String Dim KeysObject As Object Dim Index As Integer Dim key As Variant Set KeysObject = ScriptEngine.Run("getKeys", JsonObject) Length = GetProperty(KeysObject, "length") ReDim KeysArray(Length - 1) Index = 0 For Each key In KeysObject KeysArray(Index) = key Index = Index + 1 Next GetKeys = KeysArray End Function |
To use it, do something like this:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
Option Explicit Public Function ReadJSON() Dim root As Object Dim content As String Dim rootKeys() As String Dim keys() As String Dim i As Integer Dim obj As Object Dim prop As Variant content = FileSys.FileToString(CurrentProject.Path & "\example0.json") content = Replace(content, vbCrLf, "") content = Replace(content, vbTab, "") JsonParser.InitScriptEngine Set root = JsonParser.DecodeJsonString(content) rootKeys = JsonParser.GetKeys(root) For i = 0 To UBound(rootKeys) Debug.Print rootKeys(i) If JsonParser.GetPropertyType(root, rootKeys(i)) = jptValue Then prop = JsonParser.GetProperty(root, rootKeys(i)) Debug.Print Nz(prop, "[null]") Else Set obj = JsonParser.GetObjectProperty(root, rootKeys(i)) RecurseProps obj, 2 End If Next i End Function Private Function RecurseProps(obj As Object, Optional Indent As Integer = 0) As Object Dim nextObject As Object Dim propValue As Variant Dim keys() As String Dim i As Integer keys = JsonParser.GetKeys(obj) For i = 0 To UBound(keys) If JsonParser.GetPropertyType(obj, keys(i)) = jptValue Then propValue = JsonParser.GetProperty(obj, keys(i)) Debug.Print Space(Indent) & keys(i) & ": " & Nz(propValue, "[null]") Else Set nextObject = JsonParser.GetObjectProperty(obj, keys(i)) Debug.Print Space(Indent) & keys(i) RecurseProps nextObject, Indent + 2 End If Next i End Function |
Admittedly, it could be easier to use. This effectively parses the values (for any valid JSON – I tested loads of it and gave a presentation at the annual PAUG conference last year without an egg on my face), but working with the values when you’re done is a bit of a headache. Essentially loop through the keys and determine if it’s a Property or Object, and recurse as required. If only JSON has an equivalent query language like XPath for XML!
One important thing to bear in mind is that this method does make use of JavaScript’s Eval() function. That function basically says “take any string and execute it as if it were JavaScript”, which has some significant security implications. Thus, we ought to ensure we’re working with a trusted source if we’re going to be using it (but this holds true for just about any external source, I think).
In any case – while Tim Hall’s interface is a bit more friendly to use and works in most cases, this one works in all cases.
If you’re interested in some more information on how to consume web services with VBA, check out the Web Work with VBA blog post. Have fun!
-jack
I have created an application called JSON Analyse and Transform for Access (JATFA) which is available via my website. This application has been designed to make importing and handling JSON files a straightforward and, in many cases, a largely automated task.
Features include:
a) Fully automated analysis of JSON files including handling of subarrays
b) Fully automated creation of tables and transform functions based on file analysis.
c) Import JSON data into normalised Access tables based on file analysis
d) Over 90 sample JSON files are supplied as examples
In the vast majority of cases, the file analysis will work with no user intervention required. However, users can choose to treat individual files as a special case, allowing the default analysis procedure you to be overwritten for that file.
For further details, see http://www.mendipdatasystems.co.uk/json-analyse-transform/4594138310.
An earlier version of the app is also available at https://www.access-programmers.co.uk/forums/showthread.php?t=295789
Hi Colin – thanks for the post. It’s a nice tool for import work, hopefully someone will find it useful
Hi Jack,
First of all, thank you So much for this code.
When I create the JsonParser Module and paste your code and I create the second with your example code I get an error on the Public Enum being Ambiguous.
Is also get an error at the Debug.print when using the Nz string.
Any Ideas?
Thanks
Hello – not sure about the ambiguous type error: apparently you have an enum defined with that name already somewhere. Do a Find in all modules for that name and see where else it comes up (maybe you accidentally pasted this code into two different modules?). Not sure about the Nz() error either: that’s the error message, and what’s the value of the prop variable?
Exactly what I need and very simple. The VBA-JSON example has tons of code and also the tool from Colin has tons of code. I like your way of the JSON read method. Now I am able to create nice recordsets and update tables with json information from a REST service. Many thanks for this great example!
Glad to help, thanks for the comment.
Hello Jack,
I tried your scripts but I’m getting troubles with “FileSys” in the ReadJSON Function.
I added the Microsoft Scripting RunTime Library but It doesn’t work anyway.
Phil
Hello – FileSys module of my own that I use in most projects. You can make your own function to read a string from a file (there’s many examples online) and replace it with that call (mostly it’s for demo purposes: typically your JSON content would be coming from a web service call rather than a file). Let me know if you need a hand locating some function to read from a file.
Here’s the FileToString function from my module. Put it in a module and name the module FileSys and the demo code should compile (I tend to prefer two part naming as described here: Module Naming) – or just remove FileSys from the demo code after you paste this function in a standard module somewhere.
Public Function FileToString(SourceFile As String) As StringDim i As Integer
Dim s As String
i = FreeFile
Open SourceFile For Input As #i
s = Input(LOF(i), i)
Close #i
FileToString = s
End Function
Hello Jack,
Thank you for posting this. I’ve been testing out the script and I’m getting and error in the GetKeys() function.
Error: Run-time error ‘9’: Subscript out of range
it’s happening on ReDim KeysArray(Length – 1)
Any ideas what might be causing the error?
Public Function GetKeys(ByVal JsonObject As Object) As String()
Dim Length As Integer
Dim KeysArray() As String
Dim KeysObject As Object
Dim Index As Integer
Dim key As Variant
Set KeysObject = ScriptEngine.Run(“getKeys”, JsonObject)
Length = GetProperty(KeysObject, “length”)
ReDim KeysArray(Length – 1)
Index = 0
For Each key In KeysObject
KeysArray(Index) = key
Index = Index + 1
Next
GetKeys = KeysArray
End Function
Hi Rich – would you be able to email me the JSON you’re trying to process so I can replicate?
It looks like it’s running into another object
see this screen shot of the spot in the json file where the error is happening
https://www.dropbox.com/s/fuz25skpwxyd0nt/redim-keysArray-error.jpg?dl=0
Hi Jack,
On processing large amount of data, i am getting “overflow” error at
GetProperty = ScriptEngine.Run(“getProperty”, JsonObject, PropertyName)
any idea, how best we can handle this?
Hi – what’s “large” – a couple hundred objects, or a couple million? If you prefer, email me (or send a link) to a sample file that I can try to reproduce the issue with.
I was getting an “Subscript out of range” error in the KetKeys function. When I debugged it I found that a key length being returned by GetProperty(KeysObject, “length”) was ZERO, which made the KeysArray dimension NEGATIVE ONE. I am not sure if I have a malformed object but the rest of the data reads fine. I altered your KetKeys to get past this.
If Length > 0 Then
ReDim KeysArray(Length – 1)
Index = 0
For Each key In KeysObject
KeysArray(Index) = key
Index = Index + 1
Next
GetKeys = KeysArray
Else
ReDim KeysArray(0)
GetKeys = KeysArray
End If
Great code, thanks a billion.
Thanks for reporting this and the fix. Next time I need to pull the code for a project I’ll update accordingly. I’d be curious to see the some sample data to repro it on my end if you could make it available via email or pastebin or the like.