How to pull JSON values into Excel sheet - json

I am trying to pull JSON values from a URL that I am working with at the moment. I may have done something like this before but I dont know what I'm missing here.
Here is the URL - https://eu-offering.kambicdn.org/offering/v2018/888/listView/golf.json?lang=en_GB&market=GB&client_id=2&channel_id=1&ncid=1568916879040&useCombined=true
And an image for clarity of what is needed to be extracted.
I ran a test using Tinman's approach as can be found here - How to get, JSON values to Work in VBA-JSON? , but i can't even apply his function, PrintJSONAccessors(), here
Public Sub exceljson()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET",
"https://eu-offering.kambicdn.org/offering/v2018/888/listView/golf.json?lang=en_GB&market=GB&client_id=2&channel_id=1&ncid=1568916879040&useCombined=true", False
http.Send
Dim results As Variant
results = BitfinexTextToArray(http.responseText)
Worksheets(1).Range("A1").Resize(UBound(results), UBound(results,2)).Value = results
MsgBox ("complete")
End Sub
Function BitfinexTextToArray(responseText As String) As Variant
Dim item As Variant, JSON As Object
Dim MaxColumns As Long
Set JSON = ParseJson(responseText)
For Each item In JSON
If item.Count > MaxColumns Then MaxColumns = item.Count
Next
Dim results As Variant
ReDim results(1 To JSON.Count, 1 To MaxColumns)
Dim c As Long, r As Long
For Each item In JSON
r = r + 1
For c = 1 To item.Count
results(r, c) = item(c)
Next
Next
BitfinexTextToArray = results
End Function
I need help with pulling the following item values from each of the JSON "event"
1. "englishName"
2. "participant"
3. "oddsFractional"

NOTE: my example uses the JsonConverter library and requires you to add a reference to the Microsoft Scripting Runtime to access the Dictionary object.
I set up a test file with JSON loaded from your URL above. After parsing the JSON data, the exercise becomes understanding how the various levels are nested and what type of data structure is being used. In your JSON, it's a mix of Collection, Array, and Dictionary in various combinations. My example below shows how you have to stack up these nested references to get the data you're looking for.
Review the information in this answer to understand how the JSON is parsed into a hierarchical data structure.
Option Explicit
Public Sub test()
Dim fileNum As Long
fileNum = FreeFile()
Dim filename As String
filename = "C:\Temp\testdata.json"
Dim jsonInput As String
Open filename For Input As #fileNum
jsonInput = Input$(LOF(fileNum), fileNum)
Close fileNum
Dim json As Object
Set json = ParseJson(jsonInput)
Debug.Print " English Name = " & json("events")(1)("event")("englishName")
Debug.Print " Participant = " & json("events")(1)("betOffers")(1)("outcomes")(2)("participant")
Debug.Print "Odds Fractional = " & json("events")(1)("betOffers")(1)("outcomes")(2)("oddsFractional")
End Sub
An even better solution will be to create an intermediate variable and then loop over the contents in an array (or collection or dictionary).

Related

Excel VBA Run-time error '13': Type mismatch using JsonConverter

Getting Error on "Excel VBA Run-time error '13': Type mismatch" using JsonConverter
my JSON
{"gstin":"33A","fp":"062020","b2b":[{"ctin":"33B","cfs":"Y","cfs3b":"Y","inv":[{"itms":[{"num":1801,"itm_det":{"csamt":0,"samt":83.97,"rt":18,"txval":933,"camt":83.97}}],"val":1050.94,"inv_typ":"R","pos":"33","idt":"10-06-2020","rchrg":"N","inum":"C3/071","chksum":"60a9044051e8b6ba1122f614143a4d1236b1399872b0ea408df6a82ba832253d"}],"fldtr1":"25-Jul-20","flprdr1":"Jun-20"}]}
my Code
Private Sub CommandButton1_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select Json files"
.AllowMultiSelect = False
If .Show() Then
Filename = .SelectedItems(1)
Dim content As String
Dim iFile As Integer: iFile = FreeFile
Open Filename For Input As #iFile
content = Input(LOF(iFile), iFile)
Dim products As Object, Item
Set products = JsonConverter.ParseJson(content)
i = 1
For Each Item In products
Debug.Print Item("gstin")
'Cells(i, 1) = Item("ctin")
'i = i + 1
Next
Close #iFile
End If
End With
End Sub
also need to implement root and keys (like: gstin, ctin, csamt, inum)
Thanks
Please limit to a single question. Your current error is because products is a dictionary and the keys are strings. You cannot do Item("gstin") as Item is a string. You would want initially products(Item) but won't be able to just use Debug.Print as not all the associated values in the dictionary are simple datatypes e.g. products("b2b") will return a collection and lead to a RTE 450 error due to incorrect syntax.
You will need to develop your code to test for which datatype is returned from the dictionary and any nested levels. [] indicates a collection you can For Each over, whereas {} indicates a dictionary. There are lots of examples on SO to help you with this and code examples that will write the entire structure out for you.

Parse JSON/XML parameters from web API

This is a quick and dirty POC I have so far from other helpful Stack posts:
Public Function WebRequest(url As String) As String
Dim http As MSXML2.xmlhttp
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.open "GET", url, False
http.send
WebRequest = http.responseText
Set http = Nothing
End Function
Private Sub Command1_Click()
Dim http As MSXML2.xmlhttp
Dim result As String
Dim url As String
Dim productId As String
productId = "2"
url = "http://localhost:1111/api/products/" & productId
result = WebRequest(url)
MsgBox result
End Sub
This calls a simple web API and returns as expected. The response reads as:
{"Id":2,"Name":"Yo-yo","Category":"Toys","Price":3.75}
What is the best way to assign the parameters to variables for use within the rest of the app?
There is no "best" way to parse JSON, but there are several existing VB6 classes for doing so. There is nothing built into VB6 or in Windows you can use though, so there isn't any obvious choice to reach for first.
If you don't want to use an existing VB6 class or a 3rd party library then you could just "manually" do the parsing with your own code. As long as the JSON you expect is pretty simple that might be all you need.
Many pitfalls here but it works for your very simple case as long as no other data types are used, the strings never have quotes or escaped symbols, etc.:
Option Explicit
Private Sub Main()
Const SIMPLE_JSON As String = _
"{""Id"":2,""Name"":""Yo-yo"",""Category"":""Toys"",""Price"":3.75}"
Dim JsonItems() As String
Dim Collection As Collection
Dim I As Long
Dim Parts() As String
Dim Value As Variant
JsonItems = Split(Mid$(SIMPLE_JSON, 2, Len(SIMPLE_JSON) - 2), ",")
Set Collection = New Collection
For I = 0 To UBound(JsonItems)
Parts = Split(JsonItems(I), ":")
Parts(0) = Mid$(Parts(0), 2, Len(Parts(0)) - 2)
If Left$(Parts(1), 1) = """" Then
Value = Mid$(Parts(1), 2, Len(Parts(1)) - 2)
Else
Value = Val(Parts(1))
End If
Collection.Add Array(Parts(0), Value), Parts(0)
Next
With Collection
For I = 1 To .Count
Debug.Print .Item(I)(0); "="; .Item(I)(1)
Next
End With
End Sub
Result:
Id= 2
Name=Yo-yo
Category=Toys
Price= 3.75
The Val() function is used for the non-String values because it is locale blind (always uses the invariant locale, which JSON numbers should always be formatted for).

VBA access to a json property without name property

I'm trying to access in VBA to over 508 "tank_id"s from a JSON file as you can see here.
I'm using cStringBuilder, cJSONScript and JSONConverter to parse the JSON file.
My main issue is that I can't pass threw all those ids because I don't know how to get the "1" "33" "49" "81" that are without names.
Here si the code I tried to get them, without success.
Const myurl2 As String = "https://api.worldoftanks.eu/wot/encyclopedia/vehicles/?application_id=demo&fields=tank_id"
Sub List_id_vehicules()
Dim strRequest
Dim xmlHttp: Set xmlHttp = CreateObject("msxml2.xmlhttp")
Dim response As Object
Dim rows As Integer
Dim counter As Integer
Dim j As String
Dim k As Integer: k = 2
Dim url As String
url = myurl2
xmlHttp.Open "GET", url, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
While Not xmlHttp.Status = 200 '<---------- wait
Wend
Set response = ParseJson(xmlHttp.ResponseText)
rows = response("meta")("count")
For counter = 1 To rows
j = counter
Dim yop As String
yop = "data[" & j & "][" & j & "]"
Sheets(2).Cells(1 + counter, 1).Value = response('data[counter]')['tank_id']
Next counter
END Sub
Could someone help me ?
The JSONConverter essentially parses the JSON text string into a set of nested Dictionary objects. So when the ParseJson function returns an Object, it's really a Dictionary. Then, when you access response("meta"), the "meta" part is the Key to the Dictionary object. It's the same thing as you nest down through the JSON.
So when you try to access response("data")("3137"), you're accessing the Dictionary returned by response("data") with the key="3137". Now the trick becomes how to get all the Keys from the response("data") object.
Here's a sample bit of code to illustrate how you can list all the tank IDs in the JSON data section:
Option Explicit
Sub ListVehicleIDs()
Const jsonFilename As String = "C:\Temp\tanks.json"
Dim fileHandle As Integer
Dim jsonString As String
fileHandle = FreeFile
Open jsonFilename For Input As #fileHandle
jsonString = Input$(LOF(fileHandle), #fileHandle)
Close #fileHandle
Dim jsonObj As Object
Set jsonObj = ParseJson(jsonString)
Dim tankCount As Long
tankCount = jsonObj("meta")("count")
Dim tankIDs As Dictionary
Set tankIDs = jsonObj("data")
Dim tankID As Variant
For Each tankID In tankIDs.keys
Debug.Print "Tank ID = " & tankID
Next tankID
End Sub

size of an array excel - json vba parser

I am using a vba json parser : https://github.com/VBA-tools/VBA-JSON . I want to loop over the elements in the B array but I am unsure how to do this. e.g.
Set Json = JsonConverter.ParseJSON("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
If you want to get back the number of elements in B how do you do this?
You get back the actual value by doing the following : Json("a")
The docs for the source vba-json state:
parse JSON and create Dictionary/Collection
So you will get back one of those objects. This seems to work:
Sub testJson()
Dim Json As Object
Set Json = JsonConverter.ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
Debug.Print Json("a") ' -> 123
Debug.Print Json("b")(2) ' -> 2
Debug.Print Json("c")("d") ' -> 456
Json("c")("e") = 789
Dim var As Object
' Get the object from Json
Set var = Json("b")
' Both Dictionary and Collection support the Count property
Debug.Print var.Count
Dim elem As Variant
For Each elem In var
Debug.Print elem
Next elem
Debug.Print JsonConverter.ConvertToJson(Json)
' -> "{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456,""e"":789}}"
End Sub
The "b" in the Json example returns a collection but for "c" you would get back a dictionary.

Excel VBA: Parsed JSON Object Loop

Per example below...Looping through an object from a parsed JSON string returns an error "Object doesn't support this property or method". Could anyone advise how to make this work? Much appreciated (I spent 6 hours looking for an answer before asking here).
Function to parse JSON string into object (this works OK).
Function jsonDecode(jsonString As Variant)
Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function
Looping through the parsed object returns error "Object doesn't support this property or method".
Sub TestJsonParsing()
Dim arr As Object 'Parse the json array into here
Dim jsonString As String
'This works fine
jsonString = "{'key1':'value1','key2':'value2'}"
Set arr = jsonDecode(jsonString)
MsgBox arr.key1 'Works (as long as I know the key name)
'But this loop doesn't work - what am I doing wrong?
For Each keyName In arr.keys 'Excel errors out here "Object doesn't support this property or method"
MsgBox "keyName=" & keyName
MsgBox "keyValue=" & arr(keyName)
Next
End Sub
PS. I looked into these libraries already:
-vba-json Wasn't able to get the example working.
-VBJSON There's no vba script included (this might work but don't know how to load it into Excel and there is minimum documentation).
Also, Is it possible to access Multidimensional parsed JSON arrays? Just getting a basic key/value array loop working would be great (sorry if asking too much). Thanks.
Edit: Here are two working examples using the vba-json library. The question above is still a mystery though...
Sub TestJsonDecode() 'This works, uses vba-json library
Dim lib As New JSONLib 'Instantiate JSON class object
Dim jsonParsedObj As Object 'Not needed
jsonString = "{'key1':'val1','key2':'val2'}"
Set jsonParsedObj = lib.parse(CStr(jsonString))
For Each keyName In jsonParsedObj.keys
MsgBox "Keyname=" & keyName & "//Value=" & jsonParsedObj(keyName)
Next
Set jsonParsedObj = Nothing
Set lib = Nothing
End Sub
Sub TestJsonEncode() 'This works, uses vba-json library
Dim lib As New JSONLib 'Instantiate JSON class object
Set arr = CreateObject("Scripting.Dictionary")
arr("key1") = "val1"
arr("key2") = "val2"
MsgBox lib.toString(arr)
End Sub
The JScriptTypeInfo object is a bit unfortunate: it contains all the relevant information (as you can see in the Watch window) but it seems impossible to get at it with VBA.
If the JScriptTypeInfo instance refers to a Javascript object, For Each ... Next won't work. However, it does work if it refers to a Javascript array (see GetKeys function below).
So the workaround is to again use the Javascript engine to get at the information we cannot with VBA. First of all, there is a function to get the keys of a Javascript object.
Once you know the keys, the next problem is to access the properties. VBA won't help either if the name of the key is only known at run-time. So there are two methods to access a property of the object, one for values and the other one for objects and arrays.
Option Explicit
Private ScriptEngine As ScriptControl
Public Sub InitScriptEngine()
Set ScriptEngine = 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 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
Public Sub TestJsonAccess()
Dim JsonString As String
Dim JsonObject As Object
Dim Keys() As String
Dim Value As Variant
Dim j As Variant
InitScriptEngine
JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }"
Set JsonObject = DecodeJsonString(CStr(JsonString))
Keys = GetKeys(JsonObject)
Value = GetProperty(JsonObject, "key1")
Set Value = GetObjectProperty(JsonObject, "key2")
End Sub
Note:
The code uses early binding. So you have to add a reference to "Microsoft Script Control 1.0".
You have to call InitScriptEngine once before using the other functions to do some basic initialization.
Codo's answer is great and forms the backbone of a solution.
However, did you know VBA's CallByName gets you pretty far in querying a JSON structure. I've just written a solution over at Google Places Details to Excel with VBA for an example.
Actually just rewritten it without managing to use the functions adding to ScriptEngine as per this example. I achieved looping through an array with CallByName only.
So some sample code to illustrate
'Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx
Option Explicit
Sub TestJSONParsingWithVBACallByName()
Dim oScriptEngine As ScriptControl
Set oScriptEngine = New ScriptControl
oScriptEngine.Language = "JScript"
Dim jsonString As String
jsonString = "{'key1':'value1','key2':'value2'}"
Dim objJSON As Object
Set objJSON = oScriptEngine.Eval("(" + jsonString + ")")
Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
Debug.Assert VBA.CallByName(objJSON, "key2", VbGet) = "value2"
Dim jsonStringArray As String
jsonStringArray = "[ 1234, 4567]"
Dim objJSONArray As Object
Set objJSONArray = oScriptEngine.Eval("(" + jsonStringArray + ")")
Debug.Assert VBA.CallByName(objJSONArray, "length", VbGet) = "2"
Debug.Assert VBA.CallByName(objJSONArray, "0", VbGet) = "1234"
Debug.Assert VBA.CallByName(objJSONArray, "1", VbGet) = "4567"
Stop
End Sub
And it does sub-objects (nested objects) as well see Google Maps example at Google Places Details to Excel with VBA
EDIT: Don't use Eval, try to parse JSON safer, see this blog post
Super Simple answer - through the power of OO (or is it javascript ;)
You can add the item(n) method you always wanted!
my full answer here
Private ScriptEngine As ScriptControl
Public Sub InitScriptEngine()
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "Object.prototype.myitem=function( i ) { return this[i] } ; "
Set foo = ScriptEngine.Eval("(" + "[ 1234, 2345 ]" + ")") ' JSON array
Debug.Print foo.myitem(1) ' method case sensitive!
Set foo = ScriptEngine.Eval("(" + "{ ""key1"":23 , ""key2"":2345 }" + ")") ' JSON key value
Debug.Print foo.myitem("key1") ' WTF
End Sub
As Json is nothing but strings so it can easily be handled if we can manipulate it the right way, no matter how complex the structure is. I don't think it is necessary to use any external library or converter to do the trick. Here is an example where I've parsed json data using string manipulation.
Sub Json_data()
Const URL = "https://api.redmart.com/v1.5.8/catalog/search?extent=2&pageSize=6&sort=1&category=bakery"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim str As Variant
With http
.Open "GET", URL, False
.send
str = Split(.responseText, "category_tags"":")
End With
On Error Resume Next
y = UBound(str)
For i = 1 To y
Cells(i, 1) = Split(Split(str(i), "title"":""")(1), """")(0)
Cells(i, 2) = Split(Split(str(i), "sku"":""")(1), """")(0)
Cells(i, 3) = Split(Split(str(i), "price"":")(1), ",")(0)
Cells(i, 4) = Split(Split(str(i), "desc"":""")(1), """")(0)
Next i
End Sub
So its 2020 and yet due to lack of an end-to-end solution, I stumbled upon this thread. It did help but if we need to access the data without Keys at runtime dynamically, the answers above, still need a few more tweaks to get the desired data.
I finally came up with a function to have an end-to-end neat solution to this JSON parsing problem in VBA. What this function does is, it takes a JSON string(nested to any level) as input and returns a formatted 2-dimensional array. This array could further easily be moved to Worksheet by plain i/j loops or could be played around conveniently due to its easy index-based accessibility.
Sample input-output
The function is saved in a JSON2Array.bas file at my Github repo.
JSON2Array-VB
A demo usage subroutine is also included in the .bas file.
Please download and import the file in your VBA modules.
I hope it helps.
I know it's late, but for those who doesn't know how to use VBJSON, you just have to:
1) Import JSON.bas into your project (Open VBA Editor, Alt + F11; File > Import File)
2) Add Dictionary reference/class
For Windows-only, include a reference to "Microsoft Scripting Runtime"
You can also use the VBA-JSON the same way, which is specific for VBA instead of VB6 and has all the documentation.