Related
I have a JSON file which contains:
array("components") of Objects
some of objects may have sub array("components") some don't.
I need to extract the labels, keys of that array also the array("values") with all the labels, values.
HOWEVER following VBA code only work with first level of "components", do not dig into second or third levels. let me know if I am doing it right?
I have been using JsonConverter to parse JSON file and then using following code:
Dim jSon As Variant
Set jSon = JsonConverter.ParseJson(jSonText)
Dim components As Collection
Set components = jSon("components")
Set Dict = New Scripting.Dictionary
Dim component As Variant
For Each component In components
Dim Label, Key As String 'not used
Dict.Add component("label"), component("key")
On Error Resume Next
Dim Values As Collection
Set Values = component("components")
Dim Data As Scripting.Dictionary
Set Data = component("data")
On Error GoTo 0
Dim value As Variant
If Not Values Is Nothing Then
For Each value In Values
Dict.Add value("label"), value("value")
Next value
ElseIf Not Data Is Nothing Then
Set Values = Data("values")
For Each value In Values
Dict.Add value("label"), value("value")
Next value
Else
'Debug.Print " No values"
End If
Set Values = Nothing
Set Data = Nothing
Next component
OLD JSON FILE - above code is working fine on this
{
"display": "form",
"settings": {
"pdf": {
"id": "1ec0f8ee-6685-5d98-a847-26f67b67d6f0",
"src": "https://files8-a847-26f67b67d6f08-a847-26f67b67d6f0"
}
},
"components": [
{
"label": "Family Name",
"tableView": true,
"key": "familyName",
"type": "textfield",
"input": true
},
{
"label": "Amount of Money",
"mask": false,
"tableView": false,
"delimiter": false,
"requireDecimal": false,
"inputFormat": "plain",
"truncateMultipleSpaces": false,
"key": "amountOfMoney",
"type": "number",
"input": true
},
{
"label": "I hereby confirm",
"tableView": false,
"key": "iHerebyConfirm",
"type": "checkbox",
"input": true,
"defaultValue": false
},
{
"label": "Which Cities do you like",
"optionsLabelPosition": "right",
"tableView": false,
"values": [
{
"label": "New York",
"value": "newNew YorkYork",
"shortcut": ""
},
{
"label": "Munich",
"value": "Munich",
"shortcut": ""
},
{
"label": "Paris",
"value": "Paris",
"shortcut": ""
},
{
"label": "Hongkong",
"value": "Hongkong",
"shortcut": ""
},
{
"label": "Mumbai",
"value": "Mumbai",
"shortcut": ""
}
],
"key": "whichCitiesDoYouLike",
"type": "selectboxes",
"input": true,
"inputType": "checkbox"
},
{
"label": "Favorite color",
"widget": "choicesjs",
"tableView": true,
"data": {
"values": [
{
"label": "black",
"value": "black"
},
{
"label": "white",
"value": "white"
},
{
"label": "blue",
"value": "blue"
},
{
"label": "green",
"value": "green"
}
]
},
"key": "favoriteColor",
"type": "select",
"input": true
},
{
"type": "button",
"label": "Submit",
"key": "submit",
"disableOnInvalid": true,
"input": true,
"tableView": false
}
]
}
To understand it I used http://jsoneditoronline.org/ try to convey in following picture
Take note that I have swapped the dictionary entry using key as the dictionary key and label as the value as label is not unique (as far as the sample JSON shows) and will cause an error (or overwrite previous entry, depending on implementation).
Your usage of On Error Resume Next should be avoided (this applies to any scenario, unless you are using it on purpose which is rarely needed) as you are basically hiding all possible errors which can cause your code to produce unintended result. You can use Exists method in If..Else..End If statement to check if the dictionary key exist first and only perform the task if it do exist.
EDIT - Code updated to handle both old and new JSON format
Private Sub Test()
'==== Change this part according to your implementation..."
Dim jsontxt As String
jsontxt = OpenTxtFile("D:/TestJSON2.txt")
'====
Dim jSon As Scripting.Dictionary
Set jSon = JsonConverter.ParseJson(jsontxt)
'Check if first level of components exist and get the collection of components if true
If jSon.Exists("components") Then
Dim components As Collection
Set components = jSon("components")
Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary
Dim comFirst As Variant
Dim comSecond As Variant
Dim comThird As Variant
Dim columnsDict As Variant
Dim valDict As Variant
For Each comFirst In components
'extract key-label from first level component
If Not Dict.Exists(comFirst("label")) Then Dict.Add comFirst("label"), comFirst("key")
'++++ New JSON Format ++++
'==== Check if second level of "components" key exist and extract label-key if true
If comFirst.Exists("components") Then
For Each comSecond In comFirst("components")
If Not Dict.Exists(comSecond("label")) Then Dict.Add comSecond("label"), comSecond("key")
'=== Check if "columns" key exist and extract the key-label if true
If comSecond.Exists("columns") Then
For Each columnsDict In comSecond("columns")
'==== Check if third level of "components" key exist and extract key-label if true
If columnsDict.Exists("components") Then
For Each comThird In columnsDict("components")
If Not Dict.Exists(comThird("label")) Then Dict.Add comThird("label"), comThird("key")
'==== Check if "values" key exist and extract label-value if true
If comThird.Exists("values") Then
For Each valDict In comThird("values")
If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
Next valDict
End If
'====
Next comThird
End If
'====
Next columnsDict
End If
'====
'==== Check if "values" key exist and extract the label-value if true
If comSecond.Exists("values") Then
For Each valDict In comSecond("values")
If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
Next valDict
End If
'====
Next comSecond
End If
'++++
'++++ Old JSON format ++++
'==== Check if "data" key exist and extract the label-value if true
If comFirst.Exists("data") Then
If comFirst("data").Exists("values") Then
For Each valDict In comFirst("data")("values")
If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
Next valDict
End If
End If
'====
'==== Check if "values" key exist and extract the label-value if true
If comFirst.Exists("values") Then
For Each valDict In comFirst("values")
If Not Dict.Exists(valDict("label")) Then Dict.Add valDict("label"), valDict("value")
Next valDict
End If
'====
'++++
Next comFirst
End If
End Sub
Try this:
https://github.com/VBA-tools/VBA-JSON
You need to import the file "JsonConverter.bas" in your project and then follow the examples in the README.md file
My JSON file looks like this:
{
"data": [
{
"id": "6003510075864",
"name": "Golf",
"audience_size": 242637550,
"path": [
"Interests",
"Sports and outdoors",
"Sports",
"Golf"
],
"description": "",
"topic": "Sports and outdoors"
},
{
"id": "6003393973731",
"name": "Persian Gulf",
"audience_size": 173453990,
"path": [
"Interests",
"Additional Interests",
"Persian Gulf"
],
"description": null,
"topic": "Hobbies and activities"
},...
As you can see, there is a nested array "path" , with an unknown length.
With this code im trying to access the section:
Dim hReq As Object, JSON As Object, item As Object, itempath As Object
(...)
For Each item In JSON("data")
ws.Cells(3 + i, 1) = item("id")
ws.Cells(3 + i, 2) = item("name")
ws.Cells(3 + i, 3) = item("audience_size")
ws.Cells(3 + i, 4) = item("description")
ws.Cells(3 + i, 5) = item("topic")
For Each itempath In item("path") ' <<< in this line I get the error Object needed..
ws.Cells(3 + i, 6) = itempath("0")
Next
i = i + 1
Next
The 2nd For each statement gives me an error .. I dont know how to handle this nested array ... thanks for any ideas ....
item("path")
...is a Collection of strings, not a collection of objects
Dim itempath 'as variant
'...
For Each itempath In item("path")
ws.Cells(3 + i, 6) = itempath
Next
'...
Basically I want to read some .JSONn files with very structured data (many arrays, items and values) and my goal is to put the items and values in an excel sheet. I have trouble getting stuck when I reach arrays data-type.
I can read the files and include some items and values using the Library VBA-JSON 2.3.1
Dim jsonObject As Object, i As Integer, FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Set JsonTS = FSO.OpenTextFile("D:\JSON\file.json", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
Set ws = Worksheets("Sheet1")
Set jsonObject = JsonConverter.ParseJson(JsonText)
i = 2
n = 1
For Each Item In jsonObject
ws.Cells(i, n) = jsonObject(Item)
i = i + 1: n = n + 1
Next
MsgBox ("Complete!")
Set jsonObject = Nothing
Here's my sructured JSON file:
{
"id": "2ca5da11-b311-43db-9661-afa3b833aad4",
"name": "_menuAposentacoes",
"auto": true,
"contexts": [],
"responses": [
{
"resetContexts": false,
"affectedContexts": [
{
"name": "aposentacoes_22-followup",
"parameters": {},
"lifespan": 2
}
],
"parameters": [
{
"id": "6e86b18e-77c1-4571-ad53-eba8db91d4b3",
"required": false,
"dataType": "#aposentacao",
"name": "aposentacao",
"value": "$aposentacao",
"promptMessages": [],
"noMatchPromptMessages": [],
"noInputPromptMessages": [],
"outputDialogContexts": [],
"isList": true
},
{
"id": "be28b756-32dd-40e7-99db-d7f91cc9ddb6",
"required": false,
"dataType": "#CGA",
"name": "CGA",
"value": "$CGA",
"promptMessages": [],
"noMatchPromptMessages": [],
"noInputPromptMessages": [],
"outputDialogContexts": [],
"isList": false
},
{
"id": "f52786f0-15cd-4fc4-983f-32b248ddcf3f",
"required": false,
"dataType": "#descontos",
"name": "descontos",
"value": "$descontos",
"promptMessages": [],
"noMatchPromptMessages": [],
"noInputPromptMessages": [],
"outputDialogContexts": [],
"isList": false
},
{
"id": "6e7f4c49-f35f-46fb-9db9-c24eb16f0b40",
"required": false,
"dataType": "#situacaoCGA",
"name": "situacaoCGA",
"value": "$situacaoCGA",
"promptMessages": [],
"noMatchPromptMessages": [],
"noInputPromptMessages": [],
"outputDialogContexts": [],
"isList": false
},
{
"id": "70328121-e748-4508-a287-7fc30a9cd9f6",
"required": false,
"dataType": "#penalizacao",
"name": "penalizacao",
"value": "$penalizacao",
"promptMessages": [],
"noMatchPromptMessages": [],
"noInputPromptMessages": [],
"outputDialogContexts": [],
"isList": false
}
],
"messages": [
{
"type": 0,
"lang": "pt",
"speech": "Some text."
},
{
"type": 4,
"lang": "pt",
"payload": {
"message": "Some text: ",
"ignoreTextResponse": false,
"platform": "kommunicate",
"metadata": {
"contentType": "300",
"templateId": "6",
"payload": [
{
"title": "Other text",
"message": "Other text"
},
{
"title": "Other text",
"message": "Other text"
},
{
"title": "Other text",
"message": "Other text"
},
{
"title": "Other text",
"message": "Other text"
}
]
}
}
},
{
"type": 4,
"lang": "pt",
"payload": {
"message": "Other text",
"ignoreTextResponse": false,
"platform": "kommunicate",
"metadata": {
"contentType": "300",
"templateId": "6",
"payload": [
{
"title": "Sim",
"message": "Sim"
},
{
"title": "Não",
"message": "Não"
}
]
}
}
}
],
"defaultResponsePlatforms": {},
"speech": []
}
],
"priority": 500000,
"webhookUsed": false,
"webhookForSlotFilling": false,
"fallbackIntent": false,
"events": []
}
Here's a useful routine that can help you determine how to parse the JSON data, based on information in this answer. The routine is recursive, so it will successively call itself to continue parsing the JSON input.
The current output is to the immediate window using Debug.Print, but you can modify these statements to put the results into worksheet cells according to your needs and format (which was not really specified in your question).
Notice that the level parameter is incremented by two with each JSON level. This is likely due to the format of the JSON source itself. For example, the top-level responses field has both a [ and a { to indicate internal structure. You can adjust the logic to deal with this however best suits your use case.
Option Explicit
Sub ImportJSON()
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim jsonFilename As String
Dim jsonFile As Object
Dim jsonText As String
jsonFilename = "D:\JSON\file.json"
Set jsonFile = fso.OpenTextFile(Filename:=jsonFilename, IOMode:=ForReading)
jsonText = jsonFile.ReadAll
jsonFile.Close
Dim json As Object
Set json = JsonConverter.ParseJson(jsonText)
OutputJSON "(top)", json, 1
End Sub
Sub OutputJSON(ByVal itemName As String, _
ByRef jsonItem As Variant, _
ByVal level As Long)
Dim item As Variant
Select Case TypeName(jsonItem)
Case "Dictionary"
For Each item In jsonItem
If IsObject(jsonItem(item)) Then
If jsonItem(item).Count = 0 Then
Debug.Print level & " " & itemName & "." & _
item & " is empty " & _
TypeName(jsonItem(item))
Else
OutputJSON itemName & "." & item, jsonItem(item), level + 1
End If
Else
Debug.Print level & " " & itemName & "." & _
item & " = " & jsonItem(item)
End If
Next item
Case "Collection"
Dim i As Long
i = 1
For Each item In jsonItem
If IsObject(item) Then
OutputJSON itemName & "[" & i & "]", item, level + 1
Else
Debug.Print level & ": " & itemName & "[" & i & "]", item
End If
i = i + 1
Next item
End Select
End Sub
im trying right now parsing mutliple JSONs in VBA in Excel. With Google and SO i managed to parse Multiple JSONs in a Format like this:
{
"name": "Starker Geschmeidiger Holz-Langbogen des Feuers",
"description": "",
"type": "Weapon",
"level": 44,
"rarity": "Masterwork",
"vendor_value": 120,
"default_skin": 3942,
"game_types": [
"Activity",
"Wvw",
"Dungeon",
"Pve"
],
"flags": [
"SoulBindOnUse"
],
"restrictions": [],
"id": 28445,
"chat_link": "[&AgEdbwAA]",
"icon": "https://render.guildwars2.com/file/C6110F52DF5AFE0F00A56F9E143E9732176DDDE9/65015.png",
"details": {
"type": "LongBow",
"damage_type": "Physical",
"min_power": 385,
"max_power": 452,
"defense": 0,
"infusion_slots": [],
"infix_upgrade": {
"id": 142,
"attributes": [
{
"attribute": "Power",
"modifier": 85
},
{
"attribute": "Precision",
"modifier": 61
}
]
},
"suffix_item_id": 24547,
"secondary_suffix_item_id": ""
}
}
I do it like this:
Private Function Get_Name(id As Integer) As String
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://api.guildwars2.com/v2/items/" & id & "?lang=de"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
For Each sItem In oJSON
If sItem = "name" Then
Get_Name = oJSON(sItem)
End If
Next
End Function
That works fine, but i have one JSON i get from the API, that has a different Format and i dont manage to get this to work too.. It hast the following Format:
[
{
"id": 12134,
"category": 5,
"count": 204
},
{
"id": 12238,
"category": 5,
"count": 150
},
{
"id": 12147,
"category": 5,
"count": 146
},
{
"id": 12142,
"category": 5,
"count": 215
},
....
]
Thats my Try so Far:
Private Function Get_Anzahl_Im_Lager(id As Integer) As Integer
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://api.guildwars2.com/v2/account/materials?access_token=" & Tabelle2.Cells(1, 7)
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
MsgBox sGetResult
Dim oJSON As Collection
Set oJSON = JsonConverter.ParseJson(sGetResult)
MsgBox oJSON
For Each sItem In oJSON
'If oJSON(sItem)("id") = id Then
' Get_Anzahl_Im_Lager = oJSON(sItem)("count")
' End If
Get_Anzahl_Im_Lager = sItem
Exit Function
Next
End Function
Problem is,according to the Debugger it parses the Array, but i just get an Empty Object back here, oJSON is empty, while sGetResult hast the JSON Data in it.
Any Solutions?
Made it.. Sometimes i should just start thinking from a new Point on :D
Private Function Get_Anzahl_Im_Lager(id As Integer) As Integer
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
If Not IsEmpty(Tabelle2.Cells(1, 7)) Then
sURL = "https://api.guildwars2.com/v2/account/materials?access_token=" & Tabelle2.Cells(1, 7)
Else
Exit Function
End If
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
Dim sItem, cnt&
For Each sItem In oJSON
cnt = cnt + 1
If oJSON(cnt)("id") = id Then
Get_Anzahl_Im_Lager = oJSON(cnt)("count")
Exit Function
End If
Next
End Function
The JSON objects are of two different types. One is dictionary and one is a collection. Use TypeName to determine which you are getting from the responseText and handle as required e.g.
Dim item As Long, oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
Select Case TypeName(oJSON)
Case "Collection"
For Each item In json
Debug.Print item("count")
Next
Case "Dictionary"
Debug.Print json("name")
End Select
I am a newbie to Backbone and need help to get and set the models from a nested Json Structure using Backbone
I have a simple model and collection below
Model:
var PmaslDataModel = Backbone.Model.extend({ });
Collection:
app.PmaslDataCollection = Backbone.Collection.extend({
url APPLICATION_URL+'aslview/getformatedDataRows',
model : PmaslDataModel
});
Initialize the collection
var pmaslDataCollection = new app.PmaslDataCollection();
Fetching the above collection returns the data in the Json Format below
{
"id" : "1",
"rowid" : "1",
"group" : "10__",
"datarows": [
{
"id": "sspvk_code",
"default_display": "1",
"order": "1",
},
{
"id": "sspvk_code2",
"default_display": "0",
"order": "0",
},
{
"id": "sspvk_code3",
"default_display": "1",
"order": "0",
}
]
},
{
"id" : "2",
"rowid" : "2",
"group" : "11__",
"datarows": [
{
"id": "sspvk_code",
"default_display": "1",
"order": "1",
},
{
"id": "sspvk_code2",
"default_display": "0",
"order": "0",
},
{
"id": "sspvk_code3",
"default_display": "1",
"order": "0",
}
]
}
I have to use the above structure to populate the values in a table where we have the row ids and the column values in the row appears in the datarows attributes
I have 2 Questions
How can I set the "default_display" value to 0 for all the datarows
with id=sspvk_code ?
If I have a particular row id how can I fetch the datarows for that
row,pass it to a underscore template and populate the template (that
is ,in the template I need to access it with model.get('attributename value')
1) To initially set default_display to 0 to all datarows with id "sspvk_code" (is that what you want?) you can use parse method like this I would say:
app.PmaslDataCollection = Backbone.Collection.extend({
url : APPLICATION_URL+'aslview/getformatedDataRows',
model : PmaslDataModel,
parse : function (response) {
// ititerate through entire collection
_.each(response, function (row) {
// find datarow with sspvk_code id and set default_display to 0
_.each(row.datarows, function (datarow) {
if (datarow.id === "sspvk_code") {
datarow.default_display = 0;
}
})
})
return response;
}
});
2) What you mean by "fetch datarows"? Your JSON looks like you already have datarows in collection.
2.If I have a particular row id how can I fetch the datarows for that
row,pass it to a underscore template and populate the template (that
is ,in the template I need to access it with model.get('attributename
value')?
Once you fetch the collection, json data will be set as models in collection. So from the collection, you can pick the model with specified row id using Collection's findWhere method.
In your case, inside your collection,
this.findWhere({rowId:2});
1.How can I set the "default_display" value to 0 for all the datarows with id=sspvk_code ?
I guess this should be the server's responsibility to set default values instead of setting it here.