VBA JSON log in TXT "" - json

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)

Related

Trying to Convert Excel Format into JSON

I am trying to convert the excel data into below JSON format but my code is not converting this is in accurate format. You help will be much appreciated.
There is extra [ in the format how to achieve this with Excel VBA.
The Excel Data
ExcelData
Required JSON Format
JSON Format
My code
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)
' We need to know how many columns are there
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 1 To rng.Rows.Count
' Skip the first row as it's been used as a header
If dataLoop > 1 Then
' Start data row
Dim rowJson As String: rowJson = "{"
' Loop through each column and combine with the header
For headerLoop = 1 To colCount
rowJson = rowJson & """" & headerRange.Value2(1, headerLoop) & """" & ":"
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & ","
Next headerLoop
' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 1)
' End data row
json = json & rowJson & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & "]"
ToJSON = json
End Function

If you want to arrange the text in json structure manner, you can use vbTab and vbLf:
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = rng.Rows(1).Cells
' We need to know how many columns are there
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 1 To rng.Rows.Count
' Skip the first row as it's been used as a header
If dataLoop > 1 Then
' Start data row
Dim rowJson As String: rowJson = vbLf & vbTab & "{" & vbLf
' Loop through each column and combine with the header
For headerLoop = 1 To colCount
rowJson = rowJson & vbTab & vbTab & """" & headerRange.Value2(1, headerLoop) & """" & ":"
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & "," & vbLf
Next headerLoop
' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 2) & vbLf
' End data row
json = json & rowJson & vbTab & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & vbLf & "]"
ToJSON = json
End Function
Sub test1()
Debug.Print ToJSON(Range("A1").CurrentRegion)
End Sub
Output:
[
{
"name":"About the inspection",
"questionText":"report name",
"questionHelp":"some help 1",
"sortOrder":"1",
"isActive":"TRUE",
"questionType":"TEXT",
"options":""
},
{
"name":"",
"questionText":"surveyor",
"questionHelp":"some help 2",
"sortOrder":"2",
"isActive":"TRUE",
"questionType":"TEXT",
"options":""
},
... and so on

Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Dim ar, r As Long, c As Long
Dim json As String, json1 As String
ar = rng.Value2
' Skip the first row as it's been used as a header
For r = 2 To UBound(ar)
If Len(ar(r, 1)) > 0 Then
' close off previous name
If Len(json) > 0 Then
' Strip out the last comma
json = Left(json, Len(json) - 1)
json = json & vbCrLf & "]},"
End If
' start new name
json = json & vbCrLf & "{ ""name"" : """ & ar(r, 1) & """," & vbCrLf & _
"""surveyQuestions"": ["
End If
If Len(ar(r, 2)) > 0 Then
' build column data json
json1 = ""
For c = 2 To UBound(ar, 2)
If Len(json1) > 0 Then json1 = json1 & "," & vbCrLf
json1 = json1 & " """ & ar(1, c) & """:""" & ar(r, c) & """"
Next
' add into json
json = json & vbCrLf & "{" & json1 & vbCrLf & "},"
End If
Next
' Strip out the last comma
json = Left(json, Len(json) - 1)
ToJSON = "{" & vbCrLf & """sections"": [" _
& json & "]}]" & vbCrLf & "}"
End Function

Since you only provided data for the 1st set of JSON format (the 2nd set of format looks weird anyway, are you sure that's correct?), below code only cater for the 1st set of JSON format:
Public Function ToJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToJSON = CVErr(xlErrNA)
Exit Function
End If
Const rootKey As String = "sections"
Const surveyKey As String = "surveyQuestions"
Dim rngArr As Variant
rngArr = rng.Value2
Dim JSONStr As String
Dim JSONSurvey As String
Dim i As Long
' Skip the first row as it's been used as a header
For i = 2 To UBound(rngArr, 1)
If rngArr(i, 1) <> vbNullString Or rngArr(i, 2) <> vbNullString Then
If rngArr(i, 1) <> vbNullString Then
Dim currentName As String
If rngArr(i, 1) <> currentName Then
If currentName <> vbNullString Then
currentName = rngArr(i, 1)
JSONStr = JSONStr & JSONSurvey & "]},{" & KeyValue(rngArr(1, 1), rngArr(i, 1)) & "," & Chr(34) & surveyKey & Chr(34) & ": ["
JSONSurvey = vbNullString
Else
currentName = rngArr(i, 1)
JSONStr = JSONStr & "{" & KeyValue(rngArr(1, 1), rngArr(i, 1)) & "," & Chr(34) & surveyKey & Chr(34) & ": ["
End If
Else
End If
Else
JSONSurvey = JSONSurvey & ","
End If
Dim n As Long
For n = 2 To UBound(rngArr, 2)
If n = 2 Then JSONSurvey = JSONSurvey & "{"
Select Case n
Case 4, 5: JSONSurvey = JSONSurvey & KeyValue(rngArr(1, n), rngArr(i, n), False)
Case Else: JSONSurvey = JSONSurvey & KeyValue(rngArr(1, n), rngArr(i, n))
End Select
If n <> UBound(rngArr, 2) Then
JSONSurvey = JSONSurvey & ","
Else
JSONSurvey = JSONSurvey & "}"
End If
Next n
End If
Next
JSONStr = JSONStr & JSONSurvey & "]}"
' Strip out the last comma
JSONStr = Left(JSONStr, Len(JSONStr) - 1)
ToJSON = "{" & Chr(34) & rootKey & Chr(34) & ": [" & _
JSONStr & _
"}]}"
End Function
Private Function KeyValue(argKey As Variant, argValue As Variant, Optional ValueAsText As Boolean = True) As String
If ValueAsText Then
KeyValue = Chr(34) & argKey & Chr(34) & ":" & Chr(34) & argValue & Chr(34)
Else
KeyValue = Chr(34) & argKey & Chr(34) & ":" & LCase(argValue)
End If
End Function
Running this to Range("A1:G23") which is your entire data will produce this:
{"sections": [{"name":"About the inspection","surveyQuestions": [{"questionText":"report name","questionHelp":"some help 1","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"surveyor","questionHelp":"some help 2","sortOrder":2,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"asssigned to","questionHelp":"some help 3","sortOrder":3,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"client firstname","questionHelp":"some help 4","sortOrder":4,"isActive":true,"questionType":"NUMBER","options":""},{"questionText":"client lastname","questionHelp":"some help 5","sortOrder":5,"isActive":true,"questionType":"STARS","options":""},{"questionText":"report reference","questionHelp":"some help 6","sortOrder":6,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"date of inspection","questionHelp":"some help 7","sortOrder":7,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"house / building number","questionHelp":"some help 8","sortOrder":8,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"address line 1","questionHelp":"some help 9","sortOrder":9,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"address line 2","questionHelp":"some help 10","sortOrder":10,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"postcode","questionHelp":"some help 11","sortOrder":11,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"weather conditions","questionHelp":"some help 12","sortOrder":12,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"property status","questionHelp":"some help 13","sortOrder":13,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"property type","questionHelp":"property help","sortOrder":14,"isActive":true,"questionType":"LIST","options":"Bungalow;Semi-detatched, Detached, Terraced, Flat"}]},{"name":"Overall opinion","surveyQuestions": [{"questionText":"our overall opinion of the property","questionHelp":"some help 15","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""}]},{"name":"About the property","surveyQuestions": [{"questionText":"type of property","questionHelp":"some help 17","sortOrder":1,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"approximate year property was built","questionHelp":"some help 18","sortOrder":2,"isActive":true,"questionType":"NUMBER","options":""},{"questionText":"approximate year the property was extended","questionHelp":"some help 19","sortOrder":3,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"approximate year the property was converted","questionHelp":"some help 20","sortOrder":4,"isActive":true,"questionType":"TEXT","options":""},{"questionText":"information relevant to flats and maisonettes","questionHelp":"some help 21","sortOrder":5,"isActive":true,"questionType":"TEXT","options":""}]}]}
And the pretty print version:
{
"sections": [
{
"name": "About the inspection",
"surveyQuestions": [
{
"questionText": "report name",
"questionHelp": "some help 1",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "surveyor",
"questionHelp": "some help 2",
"sortOrder": 2,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "asssigned to",
"questionHelp": "some help 3",
"sortOrder": 3,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "client firstname",
"questionHelp": "some help 4",
"sortOrder": 4,
"isActive": true,
"questionType": "NUMBER",
"options": ""
},
{
"questionText": "client lastname",
"questionHelp": "some help 5",
"sortOrder": 5,
"isActive": true,
"questionType": "STARS",
"options": ""
},
{
"questionText": "report reference",
"questionHelp": "some help 6",
"sortOrder": 6,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "date of inspection",
"questionHelp": "some help 7",
"sortOrder": 7,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "house / building number",
"questionHelp": "some help 8",
"sortOrder": 8,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "address line 1",
"questionHelp": "some help 9",
"sortOrder": 9,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "address line 2",
"questionHelp": "some help 10",
"sortOrder": 10,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "postcode",
"questionHelp": "some help 11",
"sortOrder": 11,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "weather conditions",
"questionHelp": "some help 12",
"sortOrder": 12,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "property status",
"questionHelp": "some help 13",
"sortOrder": 13,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "property type",
"questionHelp": "property help",
"sortOrder": 14,
"isActive": true,
"questionType": "LIST",
"options": "Bungalow;Semi-detatched, Detached, Terraced, Flat"
}
]
},
{
"name": "Overall opinion",
"surveyQuestions": [
{
"questionText": "our overall opinion of the property",
"questionHelp": "some help 15",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
}
]
},
{
"name": "About the property",
"surveyQuestions": [
{
"questionText": "type of property",
"questionHelp": "some help 17",
"sortOrder": 1,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "approximate year property was built",
"questionHelp": "some help 18",
"sortOrder": 2,
"isActive": true,
"questionType": "NUMBER",
"options": ""
},
{
"questionText": "approximate year the property was extended",
"questionHelp": "some help 19",
"sortOrder": 3,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "approximate year the property was converted",
"questionHelp": "some help 20",
"sortOrder": 4,
"isActive": true,
"questionType": "TEXT",
"options": ""
},
{
"questionText": "information relevant to flats and maisonettes",
"questionHelp": "some help 21",
"sortOrder": 5,
"isActive": true,
"questionType": "TEXT",
"options": ""
}
]
}
]
}
Disclaimer: the code looks messy but it's late and it works!

Access nested values in JSON-Object in VBA

I would like to get data from a JSON-Object, that I got from a Rest-API, with VBA to display some data into an Excel-Worksheet. I'm using the library (VBA-JSON v2.3.1 JsonConverter).
I have the following JSON-Object:
{
"devices": [
{
"data": [
{
"id": 0,
"name": "Hello"
},
{
"id": 1,
"name": "How are you?"
},
{
"id": 2,
"name": "Bye"
}
],
"type": "LORA"
}
],
"includedTypes": [
"LORA"
]
}
I want to get the objects in the array from "data".
My VBA-Code is this:
Dim js1Object As Object
Dim response1 As String
strUrl = "https://XXXXXXXXXXXdevices
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.SetRequestHeader "Authorization", "Bearer " & apitoken
.Send
response1 = hReq.responseText
MsgBox response1
Set js1Object = JsonConverter.ParseJson(response1)
j = 31
For Each item In js1Object("devices")
ws.Cells(j, 7) = item("id")
ws.Cells(j, 10) = item("name")
j = j + 1
Next
MsgBox (response1)
End With
How can I access the values from "data"?
If the JSON would look like the object below, my code would work. But my problem is, that the response that I get, is more nested and I can't directly access "data".
{
"devices": [
{
"id": 0,
"name": "Hello"
},
{
"id": 1,
"name": "How are you?"
},
{
"id": 2,
"name": "Bye"
}
]
}
I just don't know, how to access deeper values in JSON-Object. The solutions from similar questions with print are not working with my code.
Thanks for helping me!

Your "root" json object is a Dictionary - the key "devices" is a Collection object, and the first element is another dictionary with two keys "data" and "type".
"data" is another Collection of Dictionaries, so you can do this to get to the contained id and name values:
Dim Json As Object, data, d
'reading json from a worksheet cell...
Set Json = JsonConverter.ParseJson(Range("A5").Value)
Set data = Json("devices")(1)("data") 'Dictionary key->Collection index->Dictionary key
For Each d In data
Debug.Print d("id"), d("name")
Next d
Output:
0 Hello
1 How are you?
2 Bye

Traversing Nested JSON using VBA

I have a JSON I am trying to parse in VBA. The JSON looks similar to the following:
{
"participantEligibilityResults": [
{
"eligibilityResult": {
"participantId": "HSA92a",
"clientId": "NIRCCCONFIG",
"environment": "CONFIG",
"errorReason": null,
"previousEvent": {
"eventDate": "2019-01-01",
"eventReason": "7",
"eligibilityDetails": [
{
"standardBenefitAreaId": "SPLIFE",
"benefitOptionId": "1XPay",
"coverageLevelId": "PPSP",
"employeeMonthlyCost": 216.67,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH"
},
{
"standardBenefitAreaId": "SPLIFE",
"benefitOptionId": "NoCoveragePay",
"coverageLevelId": null,
"employeeMonthlyCost": 0.0,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH"
}
],
"dependents": []
},
"currentEvent": {
"eventDate": "2020-03-14",
"eventReason": "5",
"eligibilityDetails": [
{
"standardBenefitAreaId": "BASICCHLIFE",
"benefitOptionId": "BCHWaive",
"coverageLevelId": null,
"employeeMonthlyCost": 0.0,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH",
"beneficiaryCollection": "Not Applicable",
"maxCoverageAmount": 0.0,
"minCoverageAmount": 0.0,
"coverageAmount": 0.0,
"preTax": true,
"postTax": false,
"userDefinedTaxability": false,
"numberOfPayPeriods": 52,
"payperiodsRemaining": 42.0
},
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "DentalPPO",
"coverageLevelId": "PPFAM2",
"employeeMonthlyCost": 29.17,
"employerMonthlyCost": 125.0,
"benefitProgramId": "ProgH",
"beneficiaryCollection": "Not Applicable",
"maxCoverageAmount": 0.0,
"minCoverageAmount": 0.0,
"preTax": true,
"postTax": false,
"userDefinedTaxability": false,
"numberOfPayPeriods": 52,
"payperiodsRemaining": 42.0
}
],
"dependents": [
{
"fullName": "Allison Drew ",
"dependentId": "5d82c4bf-609d-4c2f-8c1b-7d8fdd8b9fde",
"relationshipType": "Spouse",
"birthDate": "1980-01-01",
"activeIndicator": true,
"approvedIndicator": true,
"studentIndicator": false,
"coverages": [
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "NoCoverageDental",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
},
{
"standardBenefitAreaId": "MEDICAL",
"benefitOptionId": "NoCoverageMedical",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
}
]
},
{
"fullName": "Adam Drew ",
"dependentId": "d3f97b64-4a50-4dea-bec8-51d3db39352a",
"relationshipType": "Child",
"birthDate": "2012-01-01",
"activeIndicator": true,
"approvedIndicator": true,
"studentIndicator": false,
"coverages": [
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "NoCoverageDental",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
},
{
"standardBenefitAreaId": "MEDICAL",
"benefitOptionId": "NoCoverageMedical",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
}
]
}
]
}
},
"changes": []
}
]
}
I am currently utilizing VBA-JSON from https://github.com/VBA-tools/VBA-JSON to parse the JSON.
JsonOptions.AllowUnquotedKeys = True
Set JSON = JsonConverter.ParseJson(jsonResponse)
Ultimately, I am looking to access participantResults | eligibilityResult | currentEvent | eligibilityDetails and participantResults | eligibilityResult | currentEvent | dependents. I have tried beginning to traverse the JSON using something like:
For Each Eligibility In JSON("participantEligibilityResults")
For Each Detail In Eligibility("eligibilityResult")
'DO SOMETHING HERE
Next
Next
Unfortunately, once I parse at the participantEligibilityResults level, I am unable to access the levels below. I get an error "Object doesn't support this property or method." Can someone point me in the right direction?

Everything enclosed in {} will be output as a dictionary, everything enclosed in [] will be a collection. You just need to follow the nesting to get where you want.
Sub Test()
Dim result As String
Dim Item, a
Dim parsedResult As Object, obj, node, k
'loading from a cell for testing...
Set parsedResult = JsonConverter.ParseJson(Sheet2.Range("A1").Value)
Set obj = parsedResult("participantEligibilityResults")(1)("eligibilityResult")
Set node = obj("currentEvent")("eligibilityDetails")(1)
DumpJSon node 'see below
Set node = obj("currentEvent")("dependents")(1)
DumpJSon node 'see below
End Sub
If there are specific items you want, then trying to create nested loops to get to them will likely not be very useful - identify the paths you want and access the values directly. If you need to (eg) loop over a collection then that needs to be part of your approach.
It's sometimes useful to double-check what you have in your parsed result, so you can use this to dump it to the Immediate window (the whole thing or only parts of it)
Sub DumpJSon(obj, Optional level As Long = 0)
Const LEVEL_STEP As Long = 5
Dim k, v, n, s, tmp
If TypeName(obj) = "Dictionary" Then
For Each k In obj.keys
s = String(level, "-") & k & " = "
If IsObject(obj(k)) Then
Debug.Print s & IIf(obj(k).Count = 0, "Empty ", "") & _
TypeName(obj(k))
DumpJSon obj(k), level + LEVEL_STEP
Else
Debug.Print s & obj(k)
End If
Next k
ElseIf TypeName(obj) = "Collection" Then
n = 1
For Each v In obj
s = String(level, "-") & "(Item #" & n & ") "
If IsObject(v) Then
Debug.Print s & IIf(v.Count = 0, "Empty ", "") & _
TypeName(v)
DumpJSon v, level + LEVEL_STEP
Else
Debug.Print s & v
End If
n = n + 1
Next v
End If
End Sub

Adding to existing JSON from excel

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

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