Adding to existing JSON from excel - json

I want to add to this JSON file in excel using vba.
So I have this JSON file
{
"root": [{
"STATUS_RESPONSE": {
"STATUS": {
"STATUS": {
"OWNER": "root"
}
},
"REQ_ID": "00000",
"RESULT": [{
"USER": {
"BUSINESS_ID": "A",
"USER_NUMBER": "45",
"LANGUAGE": "F"
}
},
{
"USER_SESSION": {
"USER_ID": "0000001009",
"HELP_URL": "http://google.com"
}
},
{
"USER_ACCESS": {
"SERVICES_ROLE": "true",
"JOURNALLING": "true"
}
}]
}
}]
}
I want to add another "USER" right below it so it looks like
{
"root": [{
"STATUS_RESPONSE": {
"STATUS": {
"STATUS": {
"OWNER": "root"
}
},
"REQ_ID": "00000",
"RESULT": [{
"USER": {
"BUSINESS_ID": "A",
"USER_NUMBER": "45",
"LANGUAGE": "F"
}
},
{
"USER": {
"BUSINESS_ID": "B",
"USER_NUMBER": "55",
"LANGUAGE": "E"
}
},
{
"USER_SESSION": {
"USER_ID": "0000001009",
"HELP_URL": "http://google.com"
}
},
{
"USER_ACCESS": {
"SERVICES_ROLE": "true",
"JOURNALLING": "true"
}
}]
}
}]
}
This is what I have currently
Private Sub CommandButton3_Click()
Dim z As Integer, items As New Collection, myitem As New Dictionary
Dim rng As Range
Dim cell As Variant
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Set JsonTS = FSO.OpenTextFile("test.json", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
Set JSON = ParseJson(JsonText)
Set rng = Range("A5")
z = 0
For Each cell In rng
myitem("BUSINESS_ID") = cell.Offset(0, 1).Value
myitem("USER_NUMBER") = cell.Offset(0, 2).Value
myitem("LANGUAGE") = cell.Offset(0, 3).Value
items.Add myitem
Set myitem = Nothing
z = z + 1
Next
myfile = Application.ActiveWorkbook.Path & "\test.json"
Open myfile For Output As #1
Print #1, ConvertToJson(myitem, Whitespace:=2)
MsgBox ("Exported to JSON file")
Close #1
End Sub
All this does is add it below the existing JSON and is not connected to it all.
How would I go about add another "USER" right below the current one with the information from excel

Related

How to populate excel with VBA from nested JSON?

JSON response
"error": null,
"metadata": {
"total": 1,
"limit": 1000,
"offset": 0
},
"data": [
{
"id": 1,
"description": "10 licenses",
"closeDate": "2018-05-22",
"date": "2018-05-22",
"notes": "",
"user": {
"id": 1,
"name": "Gustav Petterson",
"role": null,
"email": "apidocs#upsales.com"
},
"client": {
"name": "Pied piper",
"id": 2,
"users": [
{
"id": 1,
"name": "Gustav Petterson",
"role": null,
"email": "apidocs#upsales.com"
}
]
},
"contact": null,
"project": null,
"regDate": "2018-05-22T11:08:26.000Z",
"stage": {
"name": "Won - Order",
"id": 12
},
"probability": 100,
"modDate": "2018-05-22T11:13:59.000Z",
"clientConnection": null,
"currencyRate": 1,
"currency": "SEK",
"locked": 0,
"custom": [
{
"value": "2018-05-23",
"valueDate": "2018-05-23",
"orgNumber": 20180523,
"fieldId": 1
}
],
"orderRow": [
{
"id": 1,
"quantity": 1,
"price": 10000,
"discount": 0,
"custom": [],
"productId": 1,
"sortId": 1,
"listPrice": 10000,
"product": {
"name": "Example product",
"id": 1,
"category": null
}
}
],
"value": 10000,
"weightedValue": 10000,
"valueInMasterCurrency": 10000,
"weightedValueInMasterCurrency": 10000,
"agreement": null,
"userRemovable": true,
"userEditable": true
}
]
}
So, I've tried to parse this into my sheets but struggled for quite some time now. What I wanted to do is get all order details into a sheet, but several levels of nested parts were constantly bugging me.
In "Data" everything goes well until it runs till the first nested item "users" that is Dictionary, or "Clients" that is Collection. I tried to run the next loop to fetch nested items but I created an even bigger mess.
Sub GetOrders()
Dim sGetResult As String
Dim d_lr As Double
Dim httpObject As Object
Dim dict_json As Object
Dim objData
Dim objOrder
d_lr = LastRow(ActiveSheet)
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://integration.upsales.com/api/v2/orders?token=" & wAdmin.Range("C4") & "&probability=100"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.setRequestHeader "Accept: ", "application/json"
httpObject.Send
sGetResult = httpObject.responseText
Set dict_json = JsonConverter.ParseJson(sGetResult)
Set objData = dict_json("data")
For Each objOrder In objData
For i = 0 To objOrder.Count - 1
Debug.Print objOrder.Items()(i)
Next I
Next objOrder
End Sub
You need to test the object type and recurse accordingly.
Set dict_json = JsonConverter.ParseJson(sGetResult)
Set objdata = dict_json("data")(1)
Dim k, v, u, p
For Each k In objdata
If VarType(objdata(k)) = 9 Then ' object
If k = "user" Then
For Each u In objdata(k)
Debug.Print "user", u, objdata(k)(u)
Next
End If
If k = "client" Then
For Each u In objdata(k)
If u = "users" Then
' for each loop for users
For i = 1 To objdata(k)(u).Count
For Each p In objdata(k)(u)(i)
Debug.Print "users", i, p, objdata(k)(u)(i)(p)
Next
Next
Else
Debug.Print "client", u, objdata(k)(u)
End If
Next
End If
Else
Debug.Print k, objdata(k)
End If
Next

MVC For Each loop on a multi level object

I have the following JSON:
{
"row2": {
"Activity_log_key": 2,
"Activity_day": "2017-01-12T00:00:00",
"Effort": 8.0,
"Comment": "comment text",
"Activity": "activity text",
"Work_group": "Project",
"Work_item": "test project 1",
"Related_category": {
"Project_phase": [
["category_name", "Design"],
["category_key", 116255]
]
}
},
"row3": {
"Activity_log_key": 3,
"Activity_day": "2017-01-12T00:00:00",
"Effort": 5.5,
"Comment": "no comments",
"Activity": "activty demo text",
"Work_group": "Project",
"Work_item": "project 2",
"Related_category": {
"Project_phase": [
["category_name", "Develop"],
["category_key", 116256]
],
"Training_provider": [
["category_name", "Analysis"],
["category_key", 116254]
]
}
}
}
I convert that JSON response to an object in the controller:
Dim client As New HttpClient
Dim request = client.GetStringAsync(url & "/effort")
request.Wait()
Dim response = request.Result
Dim jsonObj As Object = New JavaScriptSerializer().Deserialize(Of Object)(response)
ViewData("response") = jsonObj
Now I try to run a For Each loop on ViewData("response") in the view but I have no results.
How can I fix that?

VBA: count items in JSON response string / trello get Cards count in a List

I'm using VBA-web (https://vba-tools.github.io/VBA-Web/) to access trello api, to get cards in a list
My function looks like that:
Public Function CountCardsinList(ListId As String) As Integer
WebHelpers.EnableLogging = False
Dim TrelloClient As New WebClient
TrelloClient.BaseUrl = "https://api.trello.com/1/"
Dim Request As New WebRequest
Request.Format = WebFormat.Json
Request.ResponseFormat = Json
Request.Resource = "lists/{ListId}/cards"
Request.AddUrlSegment "ListId", ListId
Request.AddQuerystringParam "key", TrelloAPIKey
Request.AddQuerystringParam "token", TrelloAPIToken
Request.AddQuerystringParam "filter", "open"
Dim Response As WebResponse
Set Response = TrelloClient.Execute(Request)
If Response.StatusCode = WebStatusCode.Ok Then
Debug.Print Response.Content '
'Response.Data("idList").Count
Debug.Print "CountCardsinList =>>> " & Response.Content
CountCardsinList = Response.Data("idList").Count
Else
MsgBox Response.StatusDescription, vbCritical, "Error " & Response.StatusCode
CountCardsinList = ""
End If
Debug.Print "CountCardsinList =>>> " & Response.Content
'Set CountCardsinList = Request
End Function
I receive correct JSON reply from the api:
[{
"id": "584e798dd570ae187b293e5b",
"checkItemStates": null,
"closed": false,
"dateLastActivity": "2016-12-30T09:24:57.531Z",
"desc": "",
"descData": null,
"idBoard": "57873ba94794058756fa0a96",
"idList": "57873bb3a725f734089702b2",
"idMembersVoted": [],
"idShort": 90,
"idAttachmentCover": null,
"manualCoverAttachment": false,
"idLabels": ["57873ba984e677fd3683bef8"],
"name": "card name / other stuff",
"pos": 1999.9923706054688,
"shortLink": "izoqvWJk",
"badges": {
"votes": 0,
"viewingMemberVoted": false,
"subscribed": false,
"fogbugz": "",
"checkItems": 0,
"checkItemsChecked": 0,
"comments": 0,
"attachments": 0,
"description": false,
"due": "2016-12-26T11:00:00.000Z",
"dueComplete": false
},
"dueComplete": false,
"due": "2016-12-26T11:00:00.000Z",
"idChecklists": [],
"idMembers": ["54f0cc079bf18f2798dda8bd"],
"labels": [{
"id": "57873ba984e677fd3683bef8",
"idBoard": "57873ba94794058756fa0a96",
"name": "Urgent",
"color": "red",
"uses": 14
}],
"shortUrl": "https://trello.com/c/vfvfdvdfv",
"subscribed": false,
"url": "https://trello.com/c/fdvfdvdfv/cfvdfv"
},
{
"id": "5832c2fa7f55fe5637d972ea",
"checkItemStates": null,
"closed": false,
"dateLastActivity": "2016-12-30T09:25:09.222Z",
"desc": "",
"descData": null,
"idBoard": "57873ba94794058756fa0a96",
"idList": "57873bb3a725f734089702b2",
"idMembersVoted": [],
"idShort": 80,
"idAttachmentCover": null,
"manualCoverAttachment": false,
"idLabels": ["57873ba984e677fd3683bef6"],
"name": "other card name",
"pos": 2023.9922790527344,
"shortLink": "XhUPgcsD",
"badges": {
"votes": 0,
"viewingMemberVoted": false,
"subscribed": false,
"fogbugz": "",
"checkItems": 0,
"checkItemsChecked": 0,
"comments": 0,
"attachments": 0,
"description": false,
"due": "2016-12-30T15:00:00.000Z",
"dueComplete": false
},
"dueComplete": false,
"due": "2016-12-30T15:00:00.000Z",
"idChecklists": [],
"idMembers": ["54fdbe1a8ecdf184596c7c07"],
"labels": [{
"id": "57873ba984e677fd3683bef6",
"idBoard": "57873ba94794058756fa0a96",
"name": "Medium",
"color": "yellow",
"uses": 1
}],
"shortUrl": "https://trello.com/c/XhdfvdfvUPgcsD",
"subscribed": false,
"url": "https://trello.com/c/XhUPgcsfdvdffvD/
"
But I cannot correctly count idList -> and I'm trying to get number of cards in a list, by using Response.Data("idList").Count
Any information how to do it proper way? or which is the best way to parse JSON data?
General:
Your JSON isn't properly closed. I added }] to the end to close and placed in cell A1 of activesheet (as I don't have the API info). I then read that in from the cell as if it were response text.
Process:
I then used JSONConverter to parse this string from the sheet. This requires you to also add a reference to Microsoft Scripting Runtime via VBE > Tools > References.
The returned object is a collection of dictionaries. I test each dictionary for the existence of an idList key and if present add 1 to the variable itemCount, which keeps track of how many idLists there are.
Code:
Public Sub GetInfoFromSheet()
Dim jsonStr As String, item As Object, json As Object, itemCount As Long
jsonStr = [A1]
Set json = JsonConverter.ParseJson(jsonStr)
For Each item In json 'collection
If item.Exists("idList") Then itemCount = itemCount + 1
Next item
Debug.Print "idList count: " & itemCount
End Sub

VB.NET need help in deserialization of a JSON

Hey I need help in deserializing this:
{
"success": true,
"rgInventory": {
"2722309060": {
"id": "2722309060",
"classid": "939801430",
"instanceid": "188530139",
"amount": "1",
"pos": 1
},
"2722173409": {
"id": "2722173409",
"classid": "937254203",
"instanceid": "188530139",
"amount": "1",
"pos": 2
},
"2721759518": {
"id": "2721759518",
"classid": "720293857",
"instanceid": "188530139",
"amount": "1",
"pos": 3
},
"2721748390": {
"id": "2721748390",
"classid": "310777652",
"instanceid": "480085569",
"amount": "1",
"pos": 4
}
}
}
at the end it should look like:
2722309060#2722173409#2721759518#2721748390
Dim result = JsonConvert.DeserializeObject(jsonstring) 'deserialize it
Dim tempfo As String = result("rgInventory").ToString 'get rgInventory
Console.WriteLine(tempfo)
how i can deserialize all 'id's?
The json contains a Dictionary of items, the IDs you want are the keys. If you deserialized it, you could get them from the Dictionary. Otherwise, you can use JParse and linq to get them:
Dim jstr As String = ...
' parse the json
Dim js As JObject = JObject.Parse(jstr)
' extract the inventory items
Dim ji As JObject = JObject.Parse(js("rgInventory").ToString)
' get and store the keys
Dim theIds As List(Of String) = ji.Properties.Select(Function(k) k.Name).ToList()
I suspect that when "success" is false that the resulting items list will be empty. Test that it works:
For Each s As String In theIds
Console.WriteLine(s)
Next
Result:
2722309060
2722173409
2721759518
2721748390

VBA JSON log in TXT ""

I finished macro that is sending request to API and getting reply in JSON format. The results are then returned to Sheet("results"). I am also creating separate log file. The problem is that the output is not in standard JSON format like:
{
"title": "Example Schema",
"type": "object",
"properties": {
"firstName": {
"type": "string"
},
"lastName": {
"type": "string"
},
"age": {
"description": "Age in years",
"type": "integer",
"minimum": 0
}
},
"required": ["firstName", "lastName"]
}
But does have "excel required" double quotes:
"{
""title"": ""Example Schema"",
""type"": ""object"",
""properties"": {
""firstName"": {
""type"": ""string""
},
""lastName"": {
""type"": ""string""
},
""age"": {
""description"": ""Age in years"",
""type"": ""integer"",
""minimum"": 0
}
},
""required"": [""firstName"", ""lastName""]
}"
My macro looks like (bit truncated):
'output path
Dim FF As Integer
FF = FreeFile
Dim FilePath As String
FilePath = ActiveWorkbook.Path & "\Log" & Format(Now(), "yyyymmdd") & ".txt"
Open FilePath For Append As FF
sJson = ""
'turncated here ...
ObjHttp.Open "POST", sURL, False
ObjHttp.setRequestHeader "Content-Type", "application/json"
ObjHttp.send (sJson)
xmlDoc.LoadXML (ObjHttp.responseText)
'log
Dim LastRow As Long
With ThisWorkbook.Sheets("Result")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Sheets("Result").Cells(LastRow + 1, 1) = Now()
Sheets("Result").Cells(LastRow + 1, 2) = ObjHttp.responseText
Write #FF, ObjHttp.responseText
Next i
Close #FF
End Sub
What do I need to change in order to remove double quote marks?
Many thanks in advance.
This one replaces double quotes marks to singe quotes
Dim findChars, replaceChars As String
findChars = """"""
replaceChars = """"
Replace(ObjHttp.responseText, findChars, replaceChars)