VBA JSON PUT request with concatenation - json

This is how I am constructing my JSON array to be sent via the PUT method where I am taking some cell value from excel:
body = "{""note"":""" & Cells(RowNote, 3).Value & """,""uniqueIdentifier:""" & Cells(RowNote, 2).Value & ",""IdentifierType"":""ACCOUNT_ID"",""CustomerId"":" & userID & "}"
However i got an error 13 mismatch.
This is an example of the JSON string that can be PUT correctly:
{"note":"call again", "uniqueIdentifier":1716, IdentifierType":"ACCOUNT_ID", "CustomerId":927560}
What should be corrected within the brackets?

Try body = "{""note"":""" & Cells(RowNote, 3).Value & """,""uniqueIdentifier"":" & Cells(RowNote, 2).Value & ",""IdentifierType"":""ACCOUNT_ID"",""CustomerId"":" & UserId & "}" if you do not want " around your integers.

Related

POST error using VBA (MS Access) for API to Neto site

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"]}}

Output ADODB.RecordSet as JSON

I'm trying to change my application so that it outputs JSON instead of HTML when it makes an AJAX request for some data. I have an ADODB RecordSet. I need to loop through it row-by-row and add/change/remove different values. Then I need to take all the modified rows and response.write them as JSON. I'm using JSON2.asp so my application already supports JSON.parse & JSON.stringify but I can't get it to spit out the multi-dimensional array as JSON.
set rs = conn.execute(strQuery)
if Not rs.EOF Then
rsArray = rs.GetRows() 'This pulls in all the results of the RecordSet as a 2-dimensional array
columnCount = ubound(rsArray,1)
rowCount = ubound(rsArray,2)
For rowIndex = 0 to rowCount 'Loop through rows as the outer loop
rsArray(3,0) = "somethingelse"
Next 'Move on to next row if there is one
response.write JSON.stringify(rsArray) & " _______ "
End If
I just need to be able to go through the results of my database query, modify the results, and then output the modified results in JSON format. What's the right way to do this?
The JSON2.asp implementation doesn't have a "Load From Database" function which means you will have to implement something to convert the ADODB.Recordset to a JSON structure yourself.
If you are willing to use a different script there is an implementation by RCDMK on GitHub that does have a LoadRecordset() method, it's called JSON object class 3.5.3.
This makes loading data from an ADODB.Recordset really straightforward.
<!-- #include virtual="/jsonObject.class.asp" -->
<%
Response.LCID = 2057
'...
Dim rs: Set rs = conn.execute(strQuery)
Dim JSON: Set JSON = New JSONobject
Call JSON.LoadRecordset(rs)
Call Response.Clear()
Response.ContentType = "application/json"
Call JSON.Write()
%>
Code has been tested using a disconnected recordset, the ... here denote assumed code to setup your recordset, connection etc
It's worth noting you could write this yourself, it's not a huge leap to loop through an ADODB.Recordset and build a JSON string. However, I would argue against for a few reasons;
It is a time-consuming exercise.
Very easy to miss something (like checking for numeric data types, when generating output).
Depending on how it is coded can make it awkward to maintain (For example, if not injecting property names directly from the recordset and choosing to "hardcode" them instead).
Why reinvent the wheel ? There are a lot of public implementations in the wild that deal with the issues raised here. Admittedly, some are better than others, but it takes five minutes to include them and give it a try.
Just for completeness here is my local test code using a disconnected recordset
<!-- #include virtual="/jsonObject.class.asp" -->
<%
Call init()
Sub init()
Dim fields: fields = Array(Array("title", adVarChar, 50), Array("firstname", adVarChar, 50), Array("lastname", adVarChar, 50), Array("age", adInteger, 4))
Dim rs: Set rs = Server.CreateObject("ADODB.Recordset")
Call InsertRow(rs, fields, Array("Mr", "Joe", "Bloggs", 31))
Call InsertRow(rs, fields, Array("Mr", "John", "Smith", 42))
Response.LCID = 2057
Dim JSON: Set JSON = New JSONobject
Call JSON.LoadRecordset(rs)
Call Response.Clear()
Response.ContentType = "application/json"
Call JSON.Write()
End Sub
Sub InsertRow(ByVal rs, fields, values)
With rs
If rs.State <> adStateOpen Then
For Each fld In fields
Call .Fields.Append(fld(0), fld(1), fld(2))
Next
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
Call .Open()
End If
Call .AddNew()
For i = 0 To UBound(fields, 1)
.Fields(fields(i)(0)).Value = values(i)
Next
Call .Update()
Call .MoveFirst()
End With
End Sub
%>
Output:
{"data":[{"title":"Mr","firstname":"Joe","lastname":"Bloggs","age":31},{"title":"Mr","firstname":"John","lastname":"Smith","age":42}]}
Here ya go. This works for me.
set rs = conn.execute(strQuery)
c=0
Response.write "["
Do Until rs.eof
'Assign variables here with whatever you need to change
title = rs(0)
fName = rs(1)
lName = rs(2)
empID = rs(3)
With Response
if c > 0 then .write ", "
.write "{" & chr(34) & "Title" & chr(34) & " : " & chr(34) & title & chr(34) & ", " & chr(34) & "FirstName" & chr(34) & " : " & chr(34) & fName & chr(34) & ", "
.write chr(34) & "LastName" & chr(34) & " : " & chr(34) & lName & chr(34) & ", " & chr(34) & "EmpID" & chr(34) & " : " & chr(34) & empID & chr(34) & "}"
End With
c = c + 1
rs.MoveNext
Loop
Response.write "]"
This will write your JSON object directly to the page.
try setting content-type to "application/json" on top of your asp page.
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Response.Buffer=True
Response.ContentType="application/json"
Response.Charset="utf-8"
'' rest of your code.. your db operations
'' response write your json
%>

Form vba filter for additional fields MS Access

I have this code for a filter option in my form. I want to built on the code to include multiple fields but I'm not sure if that is possible or how I could do that.
Here is what I have so far:
If Not IsNull(Me.searchlat) Then
strWhere = strWhere & "([Status] = """ & Me.searchlat & """) AND "
End If
Me.Filter = strWhere
Me.FilterOn = True
This is how I attempted to add additional fields and failed:
strWhere = strWhere & "([Status] = """ & Me.searchlat & """) OR [workername] = """ & Me.searchlat & """) AND "
The number of brackets in your statement does not add up and the AND at the end is incorrect, because there is no further criteria linked by it.
Additionally I would recommend using single quotation marks inside the sql string. That makes clearer, which quotation mark has which purpose.
strWhere = strWhere & " [Status] = '" & Me.searchlat & "' OR [workername] = '" & Me.searchlat & "'"
The brackets had no effect in your excerpt at all therefore I removed them. But depending on the original where-condition in strWhere and the intention of your filter you might need to add some again.

Parsing JSON (US BLS) in VBA from MS Access

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

AM I using DO WHILE NOT and EOF in VBscript Properly

Finally the administrator configured the IIS for me the error message is listed below.
Set SQLStream = CreateObject("ADODB.Stream")
Set SQLConnection = CreateObject("ADODB.Connection")
Set SQLCommand = CreateObject("ADODB.Command")
Set SQLRecordSet = CreateObject("ADODB.RecordSet")
SQLConnection.Open "Provider=sqloledb;SERVER=SQLPROD;DATABASE=MyDataBase;UID=MyUsername;PWDMyPassword;"
'Response.Write("Connection Status: " & SQLConnection.State) & vbnewline
'Response.Write("Connection Provider: " & SQLConnection.Provider) & vbnewline
'Response.Write("Version: " & SQLConnection.Version) & vbnewline
SQLCommand.ActiveConnection = SQLConnection
SQLCommand.CommandText = "SELECT Seminars.Year, Seminars.SeminarID, Seminars.Theme, Seminar_Week.First, Seminar_Week.Last, Seminar_Week.WeekID, Seminar_Week.Date, Seminar_Week.Affiliation FROM Seminars CROSS JOIN Seminar_Week"
'Response.Write("SQL Command Passed in: " & SQLCommand.CommandText)
Set adoRec = SQLCommand.Execute()
file1 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & adoRec("Year") & "_" & adoRec("Last") & ".pdf"
file2 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "(handouts).pdf"
file3 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "_Flyer.pdf"
Set fso = CreateObject("scripting.filesystemobject")
Response.Write("<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png" & " alt=" & "Expand/Collapse" & " id=" & "arrow_" & adoRec("Week") & " /><strong>[" & adoRec("Date") & "]</strong> " & ""&aroRec("First") & adoRec("Last") & ", " & adoRec("Affiliation") & "</p>")
The very last line of code causes this error
ADODB.Recordset error '800a0cc1'
Item cannot be found in the collection corresponding to the requested name or ordinal.
FilePath, line 244
Line 244 is the very last line of code that should write Some information about each seminar on the webpage.
I'm pretty sure at this point I am pointing to an incorrect file path because I have an extra space somewhere in all the different string.
My question now is Would the ones in the very beginning, meaning the ones used in
"<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png"
be causing the trouble.
I'm also unfamiliar with using the "Expand/collapse" so if someone could tell me a little more about that. I am trying to fix someone elses code so I am a little behind the 8 ball.
One small step to a solution:
Your SQL
"SELECT * FROM Seminars WHERE [SeminarID] = 5 ORDER BY DESC"
is definitely wrong: ORDER BY needs (at least) a column name: ORDER BY [SeminarID] DESC.
If that does not solve all your problems, we'll have to think about a step by step approach.
If you get errors, tell us about them (number, description, line). That's what I meant, when I ask you to publish them. If you can't better info than "There was an error when processing the URL" from IIS, then you have to write some command line script to get the database related code absolutely right.
Start with experiments.vbs:
Dim sCS : sCS = !your connection string!
Dim oCN : Set oCN = CreateObject("ADODB.Connection")
oCN.Open sCS
WScript.Echo "CN open:", oCN.State
Dim sSQL : sSQL = !your SQL statement!
Dim oRS : Set oRS = oCN.Execute(sSQL)
WScript.Echo "RS EOF:", CStr(oRS.EOF)
WScript.Echo "Frs Col:", oRS.Fields(0).Name, oRS.Fields(0).Type
Dim i : i = 0
Do Until oRS.EOF
WScript.Echo i, oRS.Fields(0).Value
i = i + 1
oRS.MoveNext
Loop
oCN.Close
and run it in a command window (DOS box): cscript experiments.vbs. This should get you either some lines like:
CN open: 1
RS EOF: False
Frs Col: Id 3
0 ...
1 ...
2 ...
or a focused/publishable error message like:
... .vbs(2465, 14) Microsoft OLE DB Provider for SQL Server: Falsche Syntax in der Nä
he des 'DESC'-Schlüsselworts.
(bad syntax near DESC), which got when I tried the statement
"SELECT * FROM Alpha ORDER BY DESC"
RS.MoveNext
Put the above code on the line before the Loop keyword to avoid an infinite loop.
Are you missing the loop keyword at the end of your loop block?
Check the syntax here: http://msdn.microsoft.com/en-us/library/eked04a7.aspx