Function to Return a JSON Like Objects Using VBA Collections and Arrays
2
$begingroup$
My goal is to create a compact function that can create a JSON Like object from JSON string. I want a function with a small footprint that I or anyone who wants to use it, can simply paste into a module and use. At 61 lines of code, I am happy with its size and portability.
Here is an image of JSON Object created from string data using a ScriptControl. Although the Locals Window displays the properties and values correctly, the object itself is extremely difficult to work with.
This image shows an object created using getJSONCollection. Because it is made of VBA Collections and Arrays, it is very easy to work with.
Option Explicit
Private Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Collection, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = New Collection
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add results, "getArray"
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
If TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add Value, KeyNames(j)
Next
End If
Set getJSONCollection = col
End Function
Sub TestJSONCollection()
Dim JSONExamples As Object, ExampleDoc As Object
Set ExampleDoc = getDocument("http://json.org/example.html")
Set JSONExamples = ExampleDoc.getElementsByTagName("Pre")
Example1 JSONExamples(0).innerText
End Sub
Sub Example1(JSONString As String)
Dim objJSON As Object, colJSON As Collection
Set objJSON = DecodeJSON(JSONString)
Set colJSON = getJSONCollection(JSONString)
Debug.Print "Example1: JSON String"
Debug.Print JSONString
Debug.Print String(20, "*") & "Example1: Output" & String(20, "*")
Debug.Print "colJSON!glossary!title:", colJSON!glossary!Title
Debug.Print "colJSON!glossary!GlossDiv!title:", colJSON!glossary!GlossDiv!Title
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso!getArray()(0)
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1)(1), "Alt Syntax"
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee
End Sub
Function DecodeJSON(JSONString As String) As Object
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
Set DecodeJSON = .Eval("(" + JSONString + ")")
End With
End Function
Function getDocument(URL As String) As Object
Dim doc As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Set getDocument = doc
Else
MsgBox "URL: " & vbCrLf & "Ready state: " & .readyState & vbCrLf & "HTTP request status: " & .Status, vbInformation, "URL Not Responding"
End If
End With
End Function
This creates a JSON Collection object from the first JSON example from json.org/example.html and outputs both the values and the method used to access the values to the Immediate Window.
Example1: JSON String
{
"glossary": {
"title": "example glossary",
"GlossDiv": {
"title": "S",
"GlossList": {
"GlossEntry": {
"ID": "SGML",
"SortAs": "SGML",
"GlossTerm": "Standard Generalized Markup Language",
"Acronym": "SGML",
"Abbrev": "ISO 8879:1986",
"GlossDef": {
"para": "A meta-markup language, used to create markup languages such as DocBook.",
"GlossSeeAlso": ["GML", "XML"]
},
"GlossSee": "markup"
}
}
}
}
}
********************Example1: Output********************
colJSON!glossary!title: example glossary
colJSON!glossary!GlossDiv!title: S
colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm: Standard Generalized Markup Language
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev: ISO 8879:1986
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para: A meta-markup language, used to create markup languages such as DocBook.
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0): GML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1): XML Alt Syntax
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee: markup
getJSONCollection:Function
Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Object, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = CreateObject("Scripting.Dictionary")
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If Len(Value) = 0 Then
'Do Nothing
ElseIf ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length - 1)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add "getArray", results
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
'Extract Array from Dictionary
If TypeName(Value) = "Dictionary" Then
If Value.Exists("getArray") Then Value = Value("getArray")
ElseIf TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add KeyNames(j), Value
Next
End If
Set getJSONCollection = col
End Function
Any feedback on ways to improve the performance or valid JSON strings that it can't parse would be appreciated?
Addendum
I modify the function to use Dictionaries instead of COllections to allow access to the keys.
Corrected the handling of the Javascript IsArray. It returns true when the value is vbNullString.
vba json
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
$endgroup$
add a comment |
2
$begingroup$
My goal is to create a compact function that can create a JSON Like object from JSON string. I want a function with a small footprint that I or anyone who wants to use it, can simply paste into a module and use. At 61 lines of code, I am happy with its size and portability.
Here is an image of JSON Object created from string data using a ScriptControl. Although the Locals Window displays the properties and values correctly, the object itself is extremely difficult to work with.
This image shows an object created using getJSONCollection. Because it is made of VBA Collections and Arrays, it is very easy to work with.
Option Explicit
Private Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Collection, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = New Collection
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add results, "getArray"
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
If TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add Value, KeyNames(j)
Next
End If
Set getJSONCollection = col
End Function
Sub TestJSONCollection()
Dim JSONExamples As Object, ExampleDoc As Object
Set ExampleDoc = getDocument("http://json.org/example.html")
Set JSONExamples = ExampleDoc.getElementsByTagName("Pre")
Example1 JSONExamples(0).innerText
End Sub
Sub Example1(JSONString As String)
Dim objJSON As Object, colJSON As Collection
Set objJSON = DecodeJSON(JSONString)
Set colJSON = getJSONCollection(JSONString)
Debug.Print "Example1: JSON String"
Debug.Print JSONString
Debug.Print String(20, "*") & "Example1: Output" & String(20, "*")
Debug.Print "colJSON!glossary!title:", colJSON!glossary!Title
Debug.Print "colJSON!glossary!GlossDiv!title:", colJSON!glossary!GlossDiv!Title
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso!getArray()(0)
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1)(1), "Alt Syntax"
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee
End Sub
Function DecodeJSON(JSONString As String) As Object
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
Set DecodeJSON = .Eval("(" + JSONString + ")")
End With
End Function
Function getDocument(URL As String) As Object
Dim doc As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Set getDocument = doc
Else
MsgBox "URL: " & vbCrLf & "Ready state: " & .readyState & vbCrLf & "HTTP request status: " & .Status, vbInformation, "URL Not Responding"
End If
End With
End Function
This creates a JSON Collection object from the first JSON example from json.org/example.html and outputs both the values and the method used to access the values to the Immediate Window.
Example1: JSON String
{
"glossary": {
"title": "example glossary",
"GlossDiv": {
"title": "S",
"GlossList": {
"GlossEntry": {
"ID": "SGML",
"SortAs": "SGML",
"GlossTerm": "Standard Generalized Markup Language",
"Acronym": "SGML",
"Abbrev": "ISO 8879:1986",
"GlossDef": {
"para": "A meta-markup language, used to create markup languages such as DocBook.",
"GlossSeeAlso": ["GML", "XML"]
},
"GlossSee": "markup"
}
}
}
}
}
********************Example1: Output********************
colJSON!glossary!title: example glossary
colJSON!glossary!GlossDiv!title: S
colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm: Standard Generalized Markup Language
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev: ISO 8879:1986
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para: A meta-markup language, used to create markup languages such as DocBook.
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0): GML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1): XML Alt Syntax
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee: markup
getJSONCollection:Function
Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Object, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = CreateObject("Scripting.Dictionary")
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If Len(Value) = 0 Then
'Do Nothing
ElseIf ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length - 1)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add "getArray", results
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
'Extract Array from Dictionary
If TypeName(Value) = "Dictionary" Then
If Value.Exists("getArray") Then Value = Value("getArray")
ElseIf TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add KeyNames(j), Value
Next
End If
Set getJSONCollection = col
End Function
Any feedback on ways to improve the performance or valid JSON strings that it can't parse would be appreciated?
Addendum
I modify the function to use Dictionaries instead of COllections to allow access to the keys.
Corrected the handling of the Javascript IsArray. It returns true when the value is vbNullString.
vba json
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
$endgroup$
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04
add a comment |
2
2
2
1
$begingroup$
My goal is to create a compact function that can create a JSON Like object from JSON string. I want a function with a small footprint that I or anyone who wants to use it, can simply paste into a module and use. At 61 lines of code, I am happy with its size and portability.
Here is an image of JSON Object created from string data using a ScriptControl. Although the Locals Window displays the properties and values correctly, the object itself is extremely difficult to work with.
This image shows an object created using getJSONCollection. Because it is made of VBA Collections and Arrays, it is very easy to work with.
Option Explicit
Private Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Collection, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = New Collection
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add results, "getArray"
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
If TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add Value, KeyNames(j)
Next
End If
Set getJSONCollection = col
End Function
Sub TestJSONCollection()
Dim JSONExamples As Object, ExampleDoc As Object
Set ExampleDoc = getDocument("http://json.org/example.html")
Set JSONExamples = ExampleDoc.getElementsByTagName("Pre")
Example1 JSONExamples(0).innerText
End Sub
Sub Example1(JSONString As String)
Dim objJSON As Object, colJSON As Collection
Set objJSON = DecodeJSON(JSONString)
Set colJSON = getJSONCollection(JSONString)
Debug.Print "Example1: JSON String"
Debug.Print JSONString
Debug.Print String(20, "*") & "Example1: Output" & String(20, "*")
Debug.Print "colJSON!glossary!title:", colJSON!glossary!Title
Debug.Print "colJSON!glossary!GlossDiv!title:", colJSON!glossary!GlossDiv!Title
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso!getArray()(0)
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1)(1), "Alt Syntax"
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee
End Sub
Function DecodeJSON(JSONString As String) As Object
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
Set DecodeJSON = .Eval("(" + JSONString + ")")
End With
End Function
Function getDocument(URL As String) As Object
Dim doc As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Set getDocument = doc
Else
MsgBox "URL: " & vbCrLf & "Ready state: " & .readyState & vbCrLf & "HTTP request status: " & .Status, vbInformation, "URL Not Responding"
End If
End With
End Function
This creates a JSON Collection object from the first JSON example from json.org/example.html and outputs both the values and the method used to access the values to the Immediate Window.
Example1: JSON String
{
"glossary": {
"title": "example glossary",
"GlossDiv": {
"title": "S",
"GlossList": {
"GlossEntry": {
"ID": "SGML",
"SortAs": "SGML",
"GlossTerm": "Standard Generalized Markup Language",
"Acronym": "SGML",
"Abbrev": "ISO 8879:1986",
"GlossDef": {
"para": "A meta-markup language, used to create markup languages such as DocBook.",
"GlossSeeAlso": ["GML", "XML"]
},
"GlossSee": "markup"
}
}
}
}
}
********************Example1: Output********************
colJSON!glossary!title: example glossary
colJSON!glossary!GlossDiv!title: S
colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm: Standard Generalized Markup Language
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev: ISO 8879:1986
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para: A meta-markup language, used to create markup languages such as DocBook.
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0): GML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1): XML Alt Syntax
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee: markup
getJSONCollection:Function
Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Object, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = CreateObject("Scripting.Dictionary")
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If Len(Value) = 0 Then
'Do Nothing
ElseIf ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length - 1)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add "getArray", results
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
'Extract Array from Dictionary
If TypeName(Value) = "Dictionary" Then
If Value.Exists("getArray") Then Value = Value("getArray")
ElseIf TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add KeyNames(j), Value
Next
End If
Set getJSONCollection = col
End Function
Any feedback on ways to improve the performance or valid JSON strings that it can't parse would be appreciated?
Addendum
I modify the function to use Dictionaries instead of COllections to allow access to the keys.
Corrected the handling of the Javascript IsArray. It returns true when the value is vbNullString.
vba json
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
$endgroup$
My goal is to create a compact function that can create a JSON Like object from JSON string. I want a function with a small footprint that I or anyone who wants to use it, can simply paste into a module and use. At 61 lines of code, I am happy with its size and portability.
Here is an image of JSON Object created from string data using a ScriptControl. Although the Locals Window displays the properties and values correctly, the object itself is extremely difficult to work with.
This image shows an object created using getJSONCollection. Because it is made of VBA Collections and Arrays, it is very easy to work with.
Option Explicit
Private Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Collection, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = New Collection
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add results, "getArray"
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
If TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add Value, KeyNames(j)
Next
End If
Set getJSONCollection = col
End Function
Sub TestJSONCollection()
Dim JSONExamples As Object, ExampleDoc As Object
Set ExampleDoc = getDocument("http://json.org/example.html")
Set JSONExamples = ExampleDoc.getElementsByTagName("Pre")
Example1 JSONExamples(0).innerText
End Sub
Sub Example1(JSONString As String)
Dim objJSON As Object, colJSON As Collection
Set objJSON = DecodeJSON(JSONString)
Set colJSON = getJSONCollection(JSONString)
Debug.Print "Example1: JSON String"
Debug.Print JSONString
Debug.Print String(20, "*") & "Example1: Output" & String(20, "*")
Debug.Print "colJSON!glossary!title:", colJSON!glossary!Title
Debug.Print "colJSON!glossary!GlossDiv!title:", colJSON!glossary!GlossDiv!Title
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso!getArray()(0)
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1):", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1)(1), "Alt Syntax"
Debug.Print "colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee:", colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee
End Sub
Function DecodeJSON(JSONString As String) As Object
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JScript"
Set DecodeJSON = .Eval("(" + JSONString + ")")
End With
End Function
Function getDocument(URL As String) As Object
Dim doc As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
If .readyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
Set getDocument = doc
Else
MsgBox "URL: " & vbCrLf & "Ready state: " & .readyState & vbCrLf & "HTTP request status: " & .Status, vbInformation, "URL Not Responding"
End If
End With
End Function
This creates a JSON Collection object from the first JSON example from json.org/example.html and outputs both the values and the method used to access the values to the Immediate Window.
Example1: JSON String
{
"glossary": {
"title": "example glossary",
"GlossDiv": {
"title": "S",
"GlossList": {
"GlossEntry": {
"ID": "SGML",
"SortAs": "SGML",
"GlossTerm": "Standard Generalized Markup Language",
"Acronym": "SGML",
"Abbrev": "ISO 8879:1986",
"GlossDef": {
"para": "A meta-markup language, used to create markup languages such as DocBook.",
"GlossSeeAlso": ["GML", "XML"]
},
"GlossSee": "markup"
}
}
}
}
}
********************Example1: Output********************
colJSON!glossary!title: example glossary
colJSON!glossary!GlossDiv!title: S
colJSON!glossary!GlossDiv!GlossList!GlossEntry!ID: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!SortAs: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossTerm: Standard Generalized Markup Language
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Acronym: SGML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!Abbrev: ISO 8879:1986
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!para: A meta-markup language, used to create markup languages such as DocBook.
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(0): GML
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossDef!GlossSeeAlso(1): XML Alt Syntax
colJSON!glossary!GlossDiv!GlossList!GlossEntry!GlossSee: markup
getJSONCollection:Function
Function getJSONCollection(ByVal Value As Variant, Optional ScriptEngine As Object) As Variant
Const DELIMITER As String = "||"
Dim col As Object, JSON As Object, KeyNames() As String, results() As Variant
Dim j As Long, k As Long, length As Long
Set col = CreateObject("Scripting.Dictionary")
If ScriptEngine Is Nothing Then
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = ''; for (var n in jsonObj) { keys += n + '" & DELIMITER & "' ; } return keys.substring(0, keys.length-" & Len(DELIMITER) & "); } "
ScriptEngine.AddCode "function isArray(jsonObj) { return ( Object.prototype.toString.call( jsonObj ) === '[object Array]' );} "
End If
If TypeName(Value) = "String" Then
Set JSON = ScriptEngine.Eval("(" + Value + ")")
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
Set JSON = Value
End If
KeyNames = Split(ScriptEngine.Run("getKeys", JSON), DELIMITER)
If Len(Value) = 0 Then
'Do Nothing
ElseIf ScriptEngine.Run("isArray", JSON) Then
length = CallByName(JSON, "length", VbGet)
ReDim results(length - 1)
For j = 0 To length - 1
Value = CallByName(JSON, j, VbGet)
For k = 0 To UBound(KeyNames)
If InStr(Value, "[object Object]") Then
Set results(j) = getJSONCollection(CallByName(JSON, KeyNames(k), VbGet), ScriptEngine)
Else
If Not IsNull(Value) Then results(j) = Value
End If
Next
Next
col.Add "getArray", results
Else
For j = 0 To UBound(KeyNames)
On Error Resume Next
Set Value = CallByName(JSON, KeyNames(j), VbGet)
If Err.Number <> 0 Then
Err.Clear
Value = CallByName(JSON, KeyNames(j), VbGet)
End If
On Error GoTo 0
'Extract Array from Dictionary
If TypeName(Value) = "Dictionary" Then
If Value.Exists("getArray") Then Value = Value("getArray")
ElseIf TypeName(Value) = "Collection" Then
'Do Nothing
ElseIf InStr(Value, "[object Object]") Then
Set Value = getJSONCollection(CallByName(JSON, KeyNames(j), VbGet), ScriptEngine)
ElseIf TypeName(Value) = "JScriptTypeInfo" Then
'Array Handler
Set Value = getJSONCollection(Value, ScriptEngine)
End If
col.Add KeyNames(j), Value
Next
End If
Set getJSONCollection = col
End Function
Any feedback on ways to improve the performance or valid JSON strings that it can't parse would be appreciated?
Addendum
I modify the function to use Dictionaries instead of COllections to allow access to the keys.
Corrected the handling of the Javascript IsArray. It returns true when the value is vbNullString.
vba json
vba json
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
edited Jul 2 '18 at 2:13
TinMan
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
asked Jun 14 '18 at 9:48
TinManTinMan
1,0841110
1,0841110
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04
add a comment |
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04
add a comment |
1 Answer
1
active
oldest
votes
0
$begingroup$
Tim's solution for this is the nicest one I have seen so far.
https://github.com/VBA-tools/VBA-JSON
It's also a bit more future proofed and can be adapted for a Mac.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
return StackExchange.using("mathjaxEditing", function () {
StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
});
});
}, "mathjax-editing");
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "196"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f196482%2ffunction-to-return-a-json-like-objects-using-vba-collections-and-arrays%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
1 Answer
1
active
oldest
votes
1 Answer
1
active
oldest
votes
active
oldest
votes
active
oldest
votes
0
$begingroup$
Tim's solution for this is the nicest one I have seen so far.
https://github.com/VBA-tools/VBA-JSON
It's also a bit more future proofed and can be adapted for a Mac.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
add a comment |
0
$begingroup$
Tim's solution for this is the nicest one I have seen so far.
https://github.com/VBA-tools/VBA-JSON
It's also a bit more future proofed and can be adapted for a Mac.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
add a comment |
0
0
0
$begingroup$
Tim's solution for this is the nicest one I have seen so far.
https://github.com/VBA-tools/VBA-JSON
It's also a bit more future proofed and can be adapted for a Mac.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
Tim's solution for this is the nicest one I have seen so far.
https://github.com/VBA-tools/VBA-JSON
It's also a bit more future proofed and can be adapted for a Mac.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
answered 13 mins ago
Nathan KNathan K
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
answered 13 mins ago
Nathan KNathan K
12
answered 13 mins ago
Nathan KNathan K
12
12
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
New contributor
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
Nathan K is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
add a comment |
add a comment |
draft saved
draft discarded
Thanks for contributing an answer to Code Review Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f196482%2ffunction-to-return-a-json-like-objects-using-vba-collections-and-arrays%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
$begingroup$
Am I reading this right - it's heavily recursive?
$endgroup$
– Raystafarian
Jun 14 '18 at 21:43
$begingroup$
Yes, The recursion is necessary handle nested JSON objects. I actually wrote this after I started a review on your question Retrieve data from eBird API and create multi-level hierarchy of locations.
$endgroup$
– TinMan
Jun 15 '18 at 1:04