I have an access database which I'm using to create a json POST API to a website utilising Neto (https://developers.neto.com.au/documentation/engineers/api-documentation). I am new to APIs, but have been researching for several months and making progress in understanding how it works. I have managed to get a 200 status response from the request which would indicate the header info (including authentication is correct) but error in relation to the body (I believe).
Code as per below:
Dim reader As New XMLHTTP60
Dim username As String, APIkey As String
Dim strJson As String
strJson = "{" & _
"'Filter': {" & _
"'OrderStatus': 'Pick'," & _
"'OutputSelector': [" & _
"'OrderID'," & _
"'ShippingOption'," & _
"]," & _
"}" & _
"}"
username = "xxx"
APIkey = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
reader.Open "POST", "https://www.yoursite.co.nz/do/WS/NetoAPI", False
reader.setRequestHeader "NETOAPI_USERNAME", username
reader.setRequestHeader "NETOAPI_KEY", APIkey
reader.setRequestHeader "Content-Type", "application/json"
reader.setRequestHeader "Accept", "application/json"
reader.setRequestHeader "NETOAPI_ACTION", "GetOrder"
reader.send strJson
Debug.Print reader.Status
Debug.Print reader.responseText
error message:
{"CurrentTime":"2021-09-17 02:42:50","Ack":"Error","Messages":[{"Error":{"Message":"JSON Error","SeverityCode":"Error"},"Warning":{"Message":"Warning","SeverityCode":"Warning","Description":"'\"' expected, at character offset 1 (before \"'Filter': {'OrderSta...\")"}}]}
Initially i am just trying to retrieve 2 pieces of data (OrderID and ShippingOption) for any orders with status of Pick.
i have tried replacing all ' with "" as i've seen in other posts along with a few other variations but with no luck.
Any help would be appreciated. Thanks
You are using single quote instead of double quotes in your JSON
The value of Filter is a collection enclosed with [ ] so I believe you need to wrap Pick as well (despite there's only 1 value).
You have an extra , after ShippingOption when it's the last value so remove that.
Try this instead:
strJSON = "{" & _
"""Filter"": {" & _
"""OrderStatus"": [""Pick""]," & _
"""OutputSelector"": [" & _
"""OrderID""," & _
"""ShippingOption""" & _
"]" & _
"}" & _
"}"
Above will produce the JSON below:
{"Filter": {"OrderStatus": ["Pick"],"OutputSelector": ["OrderID","ShippingOption"]}}
I'm having trouble using the JSON-VBA converter with a multiple values key.
I have the normal recursion routines written to navigate JSON trees but here's an example of a simple JSON parse which I can't seem to get to work.
See this for the VBA-JSON converter software, which is terrific and fast.
Environment: Windows 7 / Access 2016 / Private LAN (no Internet)
Here's the code:
Option Compare Database
Option Explicit
Sub testparse()
Dim js As String, i As Long, jo As Object, item As Variant
Dim keys(), vals()
' fails on this string
js = "{ !Category!: !Famous Pets!," & _
"!code!: [!a!,!b!,!c!] }" ' string with multiple values
' with the following string, this works
js = "{ !Category!: !Famous Pets!," & _
" !code!: !singlecodevalue! }"
js = Replace(js, "!", Chr(34)) ' replace ! with quotes
Debug.Print " js = " & js
Set jo = JsonConverter.ParseJson(js) ' returns object with json elements
i = 0
ReDim keys(1 To jo.Count)
ReDim vals(1 To jo.Count)
Debug.Print " Number keys found at top level " & jo.Count
For Each item In jo
i = i + 1
keys(i) = item
vals(i) = jo(item)
Next item
For i = 1 To jo.Count
Debug.Print "key " & keys(i) & " = " & vals(i)
Next i
End Sub
For each item you encounter when running through a JSON object, you have to determine what you're dealing with -- especially if you don't know ahead of time how many items in an array! It gets even trickier if you have a compound JSON structure with collections inside arrays and such.
The bottom line is that you have to check each item you pull out of the JSON object and figure out what it is before accessing it. The top level of a JSON object (assuming the use of JsonConverter) will always be a Dictionary. So you can count on looping through the keys of the top level dictionary:
Dim json As Dictionary
Set json = JsonConverter.ParseJson(someJsonString)
Dim topLevelKey As String
For Each topLevelKey In json
Dim item As Variant
Debug.Print topLevelKey & " = " & item
Next topLevelKey
The problem with this is the item is not always a simple string. It can be a value (String), an array (Collection), or a group (Dictionary). See this answer as a good reference.
Basically, this means you have to check each item before you use it. So you can check it like this:
Select Case TypeName(item)
Case "Collection"
'--- loop through the item as a Collection
Case "Dictionary"
'--- loop through the item as a Dictionary
Case Else
'--- the item is a value of some type (String, Boolean, etc)
End Select
In my example here, I created a sub called ParseItem that checks each of the items in this manner. Reworking your original code into the example below:
Option Explicit
Sub testparse()
Dim js As String, i As Long, jo As Object, item As Variant
Dim keys(), vals()
' fails on this string
js = "{ !Category!: !Famous Pets!," & _
"!code!: [!a!,!b!,!c!] }" ' string with multiple values
' with the following string, this works
' js = "{ !Category!: !Famous Pets!," & _
' " !code!: !singlecodevalue! }"
'--- compound example
' js = "{ !Category!: !Famous Pets!,!code!: [!a!,!b!,{!c! : { !c1! : !1!, !c2!:!2!}}] }"
js = Replace(js, "!", Chr(34)) ' replace ! with quotes
Debug.Print "----------------------"
Debug.Print "js = " & js
Set jo = JsonConverter.ParseJson(js) ' returns object with json elements
ParseDictionary 1, "root", jo
End Sub
Private Sub ParseCollection(ByVal level As Long, _
ByVal key As String, _
ByRef jsonCollection As Variant)
Dim item As Variant
For Each item In jsonCollection
ParseItem level, key, item
Next item
End Sub
Private Sub ParseDictionary(ByVal level As Long, _
ByVal key As String, _
ByRef jsonDictionary As Variant)
Dim dictKey As Variant
For Each dictKey In jsonDictionary
ParseItem level, dictKey, jsonDictionary(dictKey)
Next dictKey
End Sub
Private Sub ParseItem(ByVal level As Long, _
ByVal key As String, _
ByRef item As Variant)
Select Case TypeName(item)
Case "Collection"
Debug.Print Format(level + 1, "00 ") & key & " (collection)"
ParseCollection (level + 1), key, item
Case "Dictionary"
Debug.Print Format(level + 1, "00 ") & key & " (dictionary)"
ParseDictionary (level + 1), key, item
Case Else
Debug.Print Format(level, "00 ") & key & " = " & item
End Select
End Sub
I am using VB-JSON parser to get data from an API and saving the data in MS access table.
I am not able to figure out how to access the -KLj9kXnKd-9txfyIqM8 and -KLjJoT7gXCMq_jHx2_z.
I have Table structure as below, and want to save the data as shown below.
|ServerID |Name |Mobile
|-KLj9kXnKd-9txfyIqM8 |Adarsh |9987
|-KLjJoT7gXCMq_jHx2_z |Manas |022
JSON
{
"-KLj9kXnKd-9txfyIqM8": {
"personmobile": "9987",
"personname": "Adarsh"
},
"-KLjJoT7gXCMq_jHx2_z": {
"personmobile": "022",
"personname": "Manas"
}
}
VBA
Public Sub GetPerson()
'I have code here which gets the json as above from api.
Dim egTran As String
If reader.Status = 200 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPerson", dbOpenDynaset, dbSeeChanges)
egTran = "[" & reader.responseText & "]"
Set coll = Json.parse(egTran)
For Each contact In coll
rs.AddNew
rs!Name = contact.Item("personname")
rs!Mobile = contact.Item("personmobile")
rs!ServerID = contact.Item("??????")
what do I write in ??????
rs.Update
Next
End If
End Sub
I am also open to using any other parser. The API is based on Firebase Database
I'm not familiar with VB-JSON, but obviously "??????" is not an item of contact.
Thus, if I run this test function:
Public Sub TestJsonText()
Dim DataCollection As Collection
Dim ResponseText As String
ResponseText = _
"{" & _
" ""-KLj9kXnKd-9txfyIqM8"": {" & _
" ""personmobile"": ""9987""," & _
" ""personname"": ""Adarsh""" & _
" }," & _
" ""-KLjJoT7gXCMq_jHx2_z"": {" & _
" ""personmobile"": ""022""," & _
" ""personname"": ""Manas""" & _
" }" & _
"}"
If ResponseText <> "" Then
Set DataCollection = CollectJson(ResponseText)
MsgBox "Retrieved" & Str(DataCollection.Count) & " root member(s)", vbInformation + vbOKOnly, "Web Service Success"
End If
Call ListFieldNames(DataCollection)
Set DataCollection = Nothing
End Sub
using the Json modules from VBA.CVRAPI it will print:
root
-KLj9kXnKd-9txfy
personmobile 9987
personname Adarsh
-KLjJoT7gXCMq_jH
personmobile 022
personname Manas
From the function ListFieldNames you can pick MemberName for the field name and DataCollection(Index)(CollectionItem.Data) for the field value to add records.
So, I had previously asked a question that was successfully answered (here: Parsing JSON (US BLS) in VBA from MS Access)
The new response I get that differs from the original question is that I've added a request to capture calculations. I've tried adding as a collection and scripting dictionary like footnotes but I see the format is not quite the same, and therefore I think it results in null when I try to gather the 1,3,6 and 12 month changes. I'd like to have some help figuring out how to capture those changes in the following response:
{
"status":"REQUEST_SUCCEEDED",
"responseTime":64,
"message":["BLS does not produce net change calculations for Series WPU381103"],
"Results":
{
"series":
[
{
"seriesID":"WPU381103",
"data":
[
{
"year":"2014",
"period":"M12",
"periodName":"December",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.0",
"3":"0.1",
"6":"0.0",
"12":"-0.7"
}
}
},
{
"year":"2014",
"period":"M11",
"periodName":"November",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.1",
"3":"-0.4",
"6":"0.0",
"12":"-0.7"
}
}
},...
You will notice that there is a part now that says calculations, and seperates values by net changes, and percent changes. I am trying to get the percent changes within the "1", "3", "6" and "12" data items.
Here is the current code I'm that does NOT find calculations but captures all the other data:
response = http.responseText
jsonSource = response
I = 0
Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")
Dim results As Scripting.Dictionary
On Error Resume Next
Set results = jsonData("Results")
Dim series As Collection
On Error Resume Next
Set series = results("series")
Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
Dim seriesId As String
seriesId = seriesItem("seriesID")
Dim Data As Collection
Set Data = seriesItem("data")
Dim dataItem As Scripting.Dictionary
For Each dataItem In Data
Dim Year As String
Year = dataItem("year")
I = 1 + I
Dim Period As String
Period = dataItem("period")
Dim periodName As String
periodName = dataItem("periodName")
Dim Value As String
Value = dataItem("value")
Dim footnotes As Collection
Set footnotes = dataItem("footnotes")
Dim footnotesItem As Scripting.Dictionary
For Each footnotesItem In footnotes
Dim Code As String
Code = footnotesItem("code")
Dim text As String
text = footnotesItem("text")
Next footnotesItem
Next dataItem
Next seriesItem
Pretty straight forward. Remember, the JSON module implements JavaScript arrays as collections and objects as Scripting.Dictionary instances.
In your context, [..].calculations, [..].calculations.net_changes and [..].calculations.pct_changes are all objects so they are all converted to Dictionary objects.
So in your code, after the For Each footnotesItem In footnotes: [..]: Next footnotesItem block (therefore, above & before the Next dataItem line), you could add the following lines:
Dim calculations As Scripting.Dictionary
Dim sIndent As String
Dim calcNetChanges As Scripting.Dictionary
Dim calcPctChanges As Scripting.Dictionary
Dim varItem As Variant
Set calculations = dataItem("calculations")
sIndent = String(4, " ")
Set calcNetChanges = calculations("net_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Net Changes:"
If calcNetChanges.Count > 0 Then
For Each varItem In calcNetChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcNetChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
Set calcPctChanges = calculations("pct_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Pct Changes:"
If calcPctChanges.Count > 0 Then
For Each varItem In calcPctChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcPctChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
which, with the json data provided, should output something like this:
2014, M12 (December) - Net Changes:
(none)
2014, M12 (December) - Pct Changes:
1: 0.0
3: 0.1
6: 0.0
12: -0.7
2014, M11 (November) - Net Changes:
(none)
2014, M11 (November) - Pct Changes:
1: 0.1
3: -0.4
6: 0.0
12: -0.7
If you want to access the items of calculations.net_changes and calculations.pct_changes directly by their keys (known in advance), you would replace the two For Each varItem blocks by, respectively:
If calcNetChanges.Exists("1") Then Debug.Print "1: " & calcNetChanges.Item("1")
If calcNetChanges.Exists("3") Then Debug.Print "3: " & calcNetChanges.Item("3")
If calcNetChanges.Exists("6") Then Debug.Print "6: " & calcNetChanges.Item("6")
If calcNetChanges.Exists("12") Then Debug.Print "12: " & calcNetChanges.Item("12")
[..]
If calcPctChanges.Exists("1") Then Debug.Print "1: " & calcPctChanges.Item("1")
If calcPctChanges.Exists("3") Then Debug.Print "3: " & calcPctChanges.Item("3")
If calcPctChanges.Exists("6") Then Debug.Print "6: " & calcPctChanges.Item("6")
If calcPctChanges.Exists("12") Then Debug.Print "12: " & calcPctChanges.Item("12")
Finally, you should note that in the json data you're giving as the example, percentages (i.e. values of items for [..].calculations.net_changes & [..].calculations.pct_changes) are provided as strings, therefore you would probably want to convert those in Double (or Single) data using Val() to perform math or other numerical operations on them, e.g.:
Dim pctChange_1 As Double, pctChange_3 As Double
Dim pctChange_6 As Double, pctChange_12 As Double
pctChange_1 = 0#
pctChange_3 = 0#
pctChange_6 = 0#
pctChange_12 = 0#
If calcPctChanges.Exists("1") Then pctChange_1 = CDbl(Val(calcPctChanges.Item("1")))
If calcPctChanges.Exists("3") Then pctChange_3 = CDbl(Val(calcPctChanges.Item("3")))
If calcPctChanges.Exists("6") Then pctChange_6 = CDbl(Val(calcPctChanges.Item("6")))
If calcPctChanges.Exists("12") Then pctChange_12 = CDbl(Val(calcPctChanges.Item("12")))
Declare calculations as a Scripting.Dictionary and its pct-changes as Scripting.Dictionary as well. Append the following code snippet after the code for footnotes. HTH
Dim calculations As Scripting.Dictionary
Set calculations = dataItem("calculations")
Dim pct_changes As Scripting.Dictionary
Set pct_changes = calculations("pct_changes")
Dim pct_change As Variant
For Each pct_change In pct_changes
Debug.Print pct_change & ":" & pct_changes(pct_change)
Next pct_change
The Debug.Print pct_change & ":" & pct_changes(pct_change) produces the following result for the first calculations set:
1:0.0
3:0.1
6:0.0
12:-0.7
Thank you in advance for your assistance.
I am using a JSON VB6 Parser which can be found at: VB JSON Parser
I have the following JSON response (Comes from the BLS website, specifically this link Here:
{"status":"REQUEST_SUCCEEDED","responseTime":71,"message":[],"Results":{
"series":
[{"seriesID":"WPS012","data":[{"year":"2014","period":"M11","periodName":"November","value":"153.6","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M10","periodName":"October","value":"147.4","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M09","periodName":"September","value":"146.5","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M08","periodName":"August","value":"156.9","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M07","periodName":"July","value":"156.4","footnotes":[{}]},{"year":"2014","period":"M06","periodName":"June","value":"179.6","footnotes":[{}]},{"year":"2014","period":"M05","periodName":
"May","value":"205.4","footnotes":[{}]},{"year":"2014","period":"M04","periodName":"April","value":"201.6","footnotes":[{}]},{"year":"2014","period":"M03","periodName":"March","value":"188.1","footnotes":[{}]},{"year":"2014","period":"M02","periodName":"February","value":"180.2","footnotes":[{}]},{"year":"2014","period":"M01","periodName":"January","value":"177.8","footnotes":[{}]},{"year":"2013","period":"M12","periodName":"December","value":"183.2","footnotes":[{}]},{"year":"2013","period":"M11","periodName":"November","value":"180.4","footnotes":[{}]},{"year":"2013","period":"M10","periodName":"October","value":"186.4","footnotes":[{}]},{"year":"2013","period":"M09","periodName":"September","value":"197.1","footnotes":[{}]},{"year":"2013","period":"M08","periodName":"August","value":"222.2","footnotes":[{}]},{"year":"2013","period":"M07","periodName":"July","value":"252.9","footnotes":[{}]},{"year":"2013","period":"M06","periodName":"June","value":"259.0","footnotes":[{}]},{"year":"2013","period":"M05","p
eriodName":"May","value":"263.7","footnotes":[{}]},{"year":"2013","period":"M04","periodName":"April","value":"249.3","footnotes":[{}]},{"year":"2013","period":"M03","periodName":"March","value":"268.1","footnotes":[{}]},{"year":"2013","period":"M02","periodName":"February","value":"267.1","footnotes":[{}]},{"year":"2013","period":"M01","periodName":"January","value":"279.7","footnotes":[{}]},{"year":"2012","period":"M12","periodName":"December","value":"283.2","footnotes":[{}]},{"year":"2012","period":"M11","periodName":"November","value":"280.8","footnotes":[{}]},{"year":"2012","period":"M10","periodName":"October","value":"286.7","footnotes":[{}]},{"year":"2012","period":"M09","periodName":"September","value":"285.2","footnotes":[{}]},{"year":"2012","period":"M08","periodName":"August","value":"298.9","footnotes":[{}]},{"year":"2012","period":"M07","periodName":"July","value":"275.8","footnotes":[{}]},{"year":"2012","period":"M06","periodName":"June","value":"226.9","footnotes":[{}]},{"year":"2012","perio
d":"M05","periodName":"May","value":"233.7","footnotes":[{}]},{"year":"2012","period":"M04","periodName":"April","value":"239.9","footnotes":[{}]},{"year":"2012","period":"M03","periodName":"March","value":"243.6","footnotes":[{}]},{"year":"2012","period":"M02","periodName":"February","value":"239.9","footnotes":[{}]},{"year":"2012","period":"M01","periodName":"January","value":"243.8","footnotes":[{}]}]}]
}}`
I am able to use the parser to return "status", "responseTime" and "message". Anything beyond that (the opening of the second curly bracket) I get nothing.
Below is the code I am trying to use:
Dim p As Object
Set p = JSON.parse(gbl_response)
'Print the text of a nested property '
Debug.Print p.Item("responseTime")
'Print the text of a property within an array '
Debug.Print p.Item("Results").Item("series").Item("seriesID")
The print of p.Item("responseTime") works and returns "71", however I get an "invalid call procedure or argument" error on the second print attempt.
For the life of me, I've searched around and have not found any solutions. I've tried this which seemed almost identical, but alas, I've tried to replicate the solution here and it seems to have not worked.
Thank you for you assistance!
Public Const jsonSource As String = "{" & _
"""status"": ""REQUEST_SUCCEEDED"", " & _
"""responseTime"": 71, " & _
"""message"": [ " & _
"], " & _
"""Results"": { " & _
"""series"": [ " & _
"{ " & _
"""seriesID"": ""WPS012"", " & _
"""data"": [ " & _
"{ " & _
"""year"": ""2014"", " & _
"""period"": ""M11"", " & _
"""periodName"": ""November"", " & _
"""value"": ""153.6"", " & _
"""footnotes"": [ " & _
"{ " & _
"""code"": ""P"", " & _
"""text"": ""Preliminary. All indexes are subject to revision four months after original publication."" " & _
"} " & _
"] " & _
"} " & _
"] " & _
"}]}}"
Sub JsonTest()
Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")
Dim results As Scripting.Dictionary
Set results = jsonData("Results")
Dim series As Collection
Set series = results("series")
Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
Dim seriesId As String
seriesId = seriesItem("seriesID")
Debug.Print seriesId
Dim data As Collection
Set data = seriesItem("data")
Dim dataItem As Scripting.Dictionary
For Each dataItem In data
Dim year As String
year = dataItem("year")
Dim period As String
period = dataItem("period")
Dim periodName As String
periodName = dataItem("periodName")
Dim value As String
value = dataItem("value")
Dim footnotes As Collection
Set footnotes = dataItem("footnotes")
Dim footnotesItem As Scripting.Dictionary
For Each footnotesItem In footnotes
Dim code As String
code = footnotesItem("code")
Dim text As String
text = footnotesItem("text")
Next footnotesItem
Next dataItem
Next seriesItem
End Sub