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
(NOTE: NZ() in Excel – the NZ() function is an Access function and not available in excel. If you’re trying to use this code in excel, you’ll need another way to handle nulls. NZ() takes any value and tests it for null, converting it to a number or string if the value is null – google can help)
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?
Hi Jack,
Thanks for sharing your code, while trying to test,
What is Nz used for, it is not defined anywhere in your code. “Sub or function not defined” at:
Debug.Print Nz(prop, “[null]”)
Hi, I added a note at the bottom of the post for Excel users trying to use NZ(). Take a quick look there please
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.
Hi Rich – thanks for the code module and example. I recognized your name as we have been on some VBA forums before, and remember you as a guy always willing to help others. Well – this is certainly helpful to me and a splendid solution.
I’ve also run into the same error:
Error: Run-time error ‘9’: Subscript out of range
it’s happening on ReDim KeysArray(Length – 1)
It occurs when the array is empty (no child elements); for example:
“dentalBenefitDetails” : [ ],
The fix I added was quite straightforward. In the RecurseProps function, when the length of the ‘nextObject ‘ object is 0, I bypass the call to the RecurseProps method (stop the recursive behavior – where the error occurred).
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)
‘ MY EDIT – WHEN THE [] HAS NO CHILDREN BYPASS
If Len(nextObject) > 0 Then
RecurseProps nextObject, Indent + 2
End If
End If
Next i
End Function
Wow, I’ve gone through many VBA JSON parsers that I’ve found on the internet and this one, by far, is the fastest and cleanest. Thank you for posting this!
I should have said in my previous post that instead of using debug.print with the indents, I built dictionaries. Made my life so much better!
Could you share how you built your dictionaries?
I remember your previous question, so it s interesting to see it back again. One question I would have is: let s say you succeed in parsing your JSON in VBA – how would you then use that object in VBA? You note that the JSON structure can be of any type, so how would you navigate the end result in VBA? My first thought might be to create a JScript which would parse the JSON (using eval or even one of the better existing libraries) and then iterate over the structure to produce a nested scripting dictionary-based object to pass back to VBA. What are you doing with your parsed JSON ? Tim Williams Jul 8 ’11 at 18:24
Hi – this really depends on the data and now deeply it’s nested, how sane the structures are, etc. It’s not so much different from any given XML data you might receive, except we have x-path tools available to navigate through xml data, and unfortunately we don’t have something similar for json. So, manual parsing it is, and all based on your requirements (which is why I didn’t include anything on it here). Good luck
Hi! I’m working on an Access Database for my school library and I need to get a scanner working so that it adds new books that we order through the Google Books API. I’ve gotten the API working fine(responding with the correct string) only it’s in JSON so I’m trying to use your Parser(I couldn’t get VBA-JSON to work as Google Books replies with a pretty advanced JSON string.
When using this code, I get the error “Object Required” with the “GetKeys” function highlighted.
Public Sub searchISBN_Change()
Refresh
Dim httpReq As Object, response As String
Dim rootKeys As Dictionary
Dim info As Object
Set httpReq = CreateObject(“MSXML2.ServerXMLHTTP”)
httpReq.Open “GET”, “https://www.googleapis.com/books/v1/volumes?q=isbn:” & Me.searchISBN.value, False
httpReq.setRequestHeader “Accept”, “application/json”
httpReq.Send
response = httpReq.responseText
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
Dim Fileout As Object
Set Fileout = fso.CreateTextFile(“S:\Library\Content\BackgroundTEMP\temp.txt”, True, True)
Fileout.Write response
Fileout.Close
JsonParser.InitScriptEngine
Set info = JsonParser.DecodeJsonString(response)
Set rootKeys = JsonParser.GetKeys(info)
Debug.Print rootKeys
End Sub
Just so you know, I forgot to mention, I know that the writing to a file is redundant in this. I was originally using a parser that required using a file(as a trial-run on this three-week long adventure) and just haven’t removed the code yet.
I’m trying to parse a web-response from Google Books API. The trouble is their responses are really advanced, especially for someone like me who is struggling with parsing JSON full stop. I tried to parse it using your parser and have received the edged key list, but all the information on the entire json files seems to be coming back as the key, INCLUDING the information inside of the keys, and there are only 2 keys even available. If I try to access key 3 it returns out of reach. Here’s an example JSON that I’m trying to parse and the response I get in the Debug Console:
JSON
{
"kind": "books#volumes",
"totalItems": 1,
"items": [
{
"kind": "books#volume",
"id": "KugbQgAACAAJ",
"etag": "vFZ18mfheFs",
"selfLink": "https://www.googleapis.com/books/v1/volumes/KugbQgAACAAJ",
"volumeInfo": {
"title": "The Anniversary Man",
"authors": [
"Roger Jon Ellory"
],
"publisher": "Orion",
"publishedDate": "2010",
"description": "Twenty years ago John Costello's life, as he knew it, ended. He and his beautiful girlfriend, Nadia, were victims of the deranged 'Hammer of God' killer who terrorised New Jersey City throughout the summer of 1984. Nadia was killed instantly. John survived, but withdrew from society, emerging only to work as a crime researcher for a major newspaper. Damaged he may be, but no one in New Jersey knows more about serial killers than John Costello. Then a new spate of murders starts - all seemingly random and unrelated - until John discovers a complex pattern that links them. But could this dark knowledge be about to threaten his life?",
"industryIdentifiers": [
{
"type": "ISBN_10",
"identifier": "0752883100"
},
{
"type": "ISBN_13",
"identifier": "9780752883106"
}
],
"readingModes": {
"text": false,
"image": false
},
"pageCount": 453,
"printType": "BOOK",
"categories": [
"Fiction"
],
"averageRating": 4.0,
"ratingsCount": 10,
"maturityRating": "NOT_MATURE",
"allowAnonLogging": false,
"contentVersion": "preview-1.0.0",
"imageLinks": {
"smallThumbnail": "http://books.google.com/books/content?id=KugbQgAACAAJ&printsec=frontcover&img=1&zoom=5&source=gbs_api",
"thumbnail": "http://books.google.com/books/content?id=KugbQgAACAAJ&printsec=frontcover&img=1&zoom=1&source=gbs_api"
},
"language": "en",
"previewLink": "http://books.google.co.uk/books?id=KugbQgAACAAJ&dq=isbn:9780752883106&hl=&cd=1&source=gbs_api",
"infoLink": "http://books.google.co.uk/books?id=KugbQgAACAAJ&dq=isbn:9780752883106&hl=&source=gbs_api",
"canonicalVolumeLink": "https://books.google.com/books/about/The_Anniversary_Man.html?hl=&id=KugbQgAACAAJ"
},
"saleInfo": {
"country": "GB",
"saleability": "NOT_FOR_SALE",
"isEbook": false
},
"accessInfo": {
"country": "GB",
"viewability": "NO_PAGES",
"embeddable": false,
"publicDomain": false,
"textToSpeechPermission": "ALLOWED",
"epub": {
"isAvailable": false
},
"pdf": {
"isAvailable": false
},
"webReaderLink": "http://play.google.com/books/reader?id=KugbQgAACAAJ&hl=&printsec=frontcover&source=gbs_api",
"accessViewStatus": "NONE",
"quoteSharingAllowed": false
},
"searchInfo": {
"textSnippet": "The serial killer to end all serial killers is out there and only one person in the whole city knows it."
}
}
]
}
AND here’s the response I get using the parser:
kind
books#volumes
totalItems
1
items
0
kind: books#volume
id: nfdejgEACAAJ
etag: dzfrACqLM/U
selfLink: https://www.googleapis.com/books/v1/volumes/nfdejgEACAAJ
volumeInfo
title: Night Star
authors
0: Alyson Noel
publisher: MacMillan Children's Books
publishedDate: 2010
description: Love and Heartbreak belong together ... There are some secrets you're better off not knowing. But once Ever Bloom is given a glimpse of what Damen is keeping from her, she has to find out more-whatever the cost. Their past together is not what she thinks - and only he remembers everything. Until now, when a vengeful friend lets her in on his secret. And it may just push Ever into someone else's arms ...
industryIdentifiers
0
type: ISBN_10
identifier: 0330528114
1
type: ISBN_13
identifier: 9780330528115
readingModes
text: False
image: False
pageCount: 302
printType: BOOK
categories
0: Ever (Fictitious character : Noël)
averageRating: 4.5
ratingsCount: 3
maturityRating: NOT_MATURE
allowAnonLogging: False
contentVersion: preview-1.0.0
imageLinks
smallThumbnail: http://books.google.com/books/content?id=nfdejgEACAAJ&printsec=frontcover&img=1&zoom=5&source=gbs_api
thumbnail: http://books.google.com/books/content?id=nfdejgEACAAJ&printsec=frontcover&img=1&zoom=1&source=gbs_api
language: en
previewLink: http://books.google.co.uk/books?id=nfdejgEACAAJ&dq=isbn:9780330528115&hl=&cd=1&source=gbs_api
infoLink: http://books.google.co.uk/books?id=nfdejgEACAAJ&dq=isbn:9780330528115&hl=&source=gbs_api
canonicalVolumeLink: https://books.google.com/books/about/Night_Star.html?hl=&id=nfdejgEACAAJ
saleInfo
country: GB
saleability: NOT_FOR_SALE
isEbook: False
accessInfo
country: GB
viewability: NO_PAGES
embeddable: False
publicDomain: False
textToSpeechPermission: ALLOWED
epub
isAvailable: False
pdf
isAvailable: False
webReaderLink: http://play.google.com/books/reader?id=nfdejgEACAAJ&hl=&printsec=frontcover&source=gbs_api
accessViewStatus: NONE
quoteSharingAllowed: False
searchInfo
textSnippet: Love and Heartbreak belong together .
Either I’m doing something wrong, or the parser is parsing the entire JSON string as one item, turning it all into a key without any information inside of it, and then outputting it to the console. If you wish, I can reply to this with the code I’m using to achieve this. Sorry to be such a bother.
Hi – while I the code I posted is a good method for working with simple, relatively flat structures from a web service or elsewhere, parsing deeply nested and complex data structures in VBA is always going to be a nightmare, even after it’s read into memory using the code in the post. In anything but a relatively simple case, I’d be much inclined to handle this in .NET and use a COM wrapper and reference the resultant dll from the VBA project. .NET can deal with this stuff quite easily (usually), where as it’s an upstream battle with VBA.
JsonParser.InitScriptEngine , this line i am getting object required error? Any idea please :)?
Hi – make sure the module name is “JsonParser” (or remove the JsonParser from that line and use only InitScriptEngine). This is because I default to two-part naming when I write VBA code: https://dymeng.com/module-naming/
Many thanks for this – works great in Excel VBA for me.
One thing I don’t understand, though.
You’re passing the plain JSON string to the JS engine with the Eval method.
How come JS knows what to do with a plain string without any preceding statement (I’d expect JSON.Parse, for example)?
Offhand, I’d guess it’s because Eval() is responsible to “resolve an expression” so to speak (e.g., Eval(“1 + 2”) = 3). Because the string we pass to it is json, it knows to convert it to an object (so, an internal thing that the script engine happens to know how to handle). That’s my guess anyway.
I liked what you shared here. The code reminded me of how much fun vba variants and array functions are. So I wrote a simple little json parser method just to play. Pretty cool how flexible variants are and how weird you can get with array functions in vba, thought I’d share. With a class container and little key search method this might be useful for simple api grabs. Regex on swirly braces, recursion, etc.. variant arrays ought to build out pretty nicely to contain nested json??
…
Public Function json_to_vbar(json As Variant) As Variant
Dim l As Long, vbar As String, keys As Variant, vals As Variant
If Len(json) > 4 Then
‘ trim edges, protect delimiters, kinda lame
json = Mid$(json, 3, Len(json) – 4)
json = Replace$(json, “\””,\”””, “||”)
json = Replace$(json, “\””:\”””, “.:”)
‘ minimal esc char handler
While l < Len(json)
l = l + 1
If Mid$(json, l, 1) = "\" Then
' skip backslashes
l = l + 1
' cpy next char to vbar string
' unless it's an esc'd dbl-quote
If Not Mid$(json, l, 1) = """" Then _
vbar = vbar + Mid$(json, l, 1)
Else
vbar = vbar + Mid$(json, l, 1)
End If
Wend
' split on major delim, run through array
keys = Split(vbar, "||"): ReDim vals(UBound(keys))
' split on minor delim, cheaty redims
For l = 0 To UBound(keys)
vals(l) = Split(keys(l), ".:")(1)
keys(l) = Split(keys(l), ".:")(0)
Next l
' pack into new array and return
json_to_vbar = Array(keys, vals)
Else
json_to_vbar = Null
End If
End Function
' SIMPLE TEST
Public Sub json_vbar_test2()
Dim res As Variant, vbar As Variant, l As Long
'
resholds responseBody of a GET request . . . here's a test value . . .' "{\"Version\":\"3.3.9.2\",\"Updated\":\"7\/16\/2019 3:11:12 PM\"}"
res = """{\""Version\"":\""3.3.9.2\"",\""Updated\"":\""7\/16\/2019 3:11:12 PM\""}"""
vbar = json_to_vbar(res)
Debug.Print "Key", "Value"
For l = 0 To UBound(vbar): Debug.Print vbar(0)(l), vbar(1)(l): Next l
' Key Value
' Version 3.3.9.2
' Updated 7/16/2019 3:11:12 PM
End Sub
Thanks for this Matt. Parsing is certainly an issue (how I wish there was an x-path equivalent for json) and the code I’d posted really only handles the transformation to VBA and not the parsing after. I’m sure someone will find this handy for shallow data handling.