Json POST request in Excel vba - json

I am trying to get trains information (date, time and prices) using the website https://www.trainline.fr/search
I would like to use Excel VBA (I am trying the POST request method via MSXML2.XMLHTT) to send a JSon request and parse the answer in a table.
I don't know which part of the right panel of
to use in my code
The request sent looks like this :
{"search":{"departure_date":"2018-04-01T10:00:00UTC","return_date":null,"cuis":{},"systems":["sncf","db","idtgv","ouigo","trenitalia","ntv","hkx","renfe","benerail","ocebo","westbahn","leoexpress","locomore","busbud","flixbus","distribusion","city_airport_train","obb","timetable"],"exchangeable_part":null,"source":null,"is_previous_available":false,"is_next_available":false,"departure_station_id":"4916","via_station_id":null,"arrival_station_id":"233","exchangeable_pnr_id":null,"passenger_ids":["173716784"],"card_ids":["7118357"]}}
I am actually using the navigate method which is very much easier but I want to progress in a more efficient and interesting method.
My actual code :
Dim objHTTP As Object
Dim Json As String
Dim result As String
'here I am pulling in the request {"search":{"departure_date":"2018...
Json = Worksheets("Test").Range("A1")
Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
URL = "https://www.trainline.fr/api/v5_1/search"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-type", "application/json"
objHTTP.send (Json)
result = objHTTP.responseText
Thank you for sharing your knowledge

Related

VBA post method request body ("MSXML2.XMLHTTP"): Error Parsing JSON: ^ Expecting '{' or '['

I'm trying to retrieve a JSON response object through the below query API. When I try to read the responseText in VBA I receive an empty result. However, the exact same request returns correct data from PostMan. Also, the correct data returns from sending the different request bodies. Whenever I try to execute Set Json = JsonConverter.ParseJson(strResponse) and I'm getting the error message Error Parsing JSON: ^ Expecting '{' or '['. Can you please help?
This is VBA code
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.ins.dell.com/gossv3/api/reporting/service/getrefid"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":extract,""sourceApplication"":DSA,""searchParameter"":[{""conditionType"":term,""key"":global_bu_id,""value"":11},{""conditionType"":wildcard,""key"":customer_num,""value"":[530007546697]},{""conditionType"":range,""key"":order_date,""value"":[{""from"":2021-08-31,""to"":2021-09-09}]},{""conditionType"":sort,""key"":order_date_time,""value"":desc}],""pageSize"":40,""pageNum"":0}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
Debug.Print strResponse
End With
Set Json = JsonConverter.ParseJson(strResponse)
Updated the fixed with the different post body:
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.us.dell.com/gossv3/api/reporting/service/getdata"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":""details"",""sourceApplication"":""DSA"",""pageNum"":0,""pageSize"":300,""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""" & ws & """]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""" & ws11 & """,""to"":""" & ws12 & """}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}]}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
End With
Set Json = JsonConverter.ParseJson(strResponse)
Probably your request is wrong and you don't get the expected response because of it... Look at the status that's returned (hReq.status and hReq.statusText), I bet it's 400 Bad Request or 500 Internal Error and not 200 Ok. (You could also use an inspecting proxy like Fiddler to look at what exactly you send and receive here.)
I can already see your request body is invalid JSON as it has unquoted strings in it... It's not the exact same as you showed in Postman! That's like the issue (or one of the issues). You have e.g. "methodType": extract, but it has to be "methodType": "extract" (in VBA ""methodType"": ""extract"") - you did it correctly in Postman but wrong in your code.
As mentioned by CherryDT - Your original reqBody had alot of missing quotes and in your updated reqBody, you are missing quotes for order_date and also you quoted pageSize and pageNum value which is supposed to be a number and thus quotes is not required:
Below should give you the same JSON string as what you had in Postman:
reqBody = "{""methodType"":""extract"",""sourceApplication"":""DSA"",""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""530007546697""]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""2021-08-31"",""to"":""2021-09-09""}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}],""pageSize"":40,""pageNum"":0}"
One way which has been working well for me so far is:
Copy the JSON string from Postman to Notepad
Open Replace dialog (Ctrl-H)
Enter " in Find What
Enter "" in Replace with
Click Replace All
Now you can copied the new string back to your VBA editor and it should produce the same output as Postman's.

Firebase REST API not parsing JSON when using VBA in Excel

I am having trouble sending JSON data to a firebase database using the rest API, the data is sent, but it does not parse. For instance if I use this curl command in command prompt in windows:
curl -X PUT -d "{\"lastName\":\"Jones\",\"firstName\":\"Bubba\"}" https://<database-name>.firebaseio.com/rest/test/.json
That results in the correct parsing of the data:
Yet, when using the following VBA code:
Sub PUSHhttpRequestTest() 'Doesn't Work!!
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Dim strURL As String: strURL = "https://<database-name>.firebaseio.com/rest/.json"
Dim strRequest
strRequest = """{\""lastName\"":\""Jones\"",\""firstName\"":\""Bubba\""}"""
Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp")
Dim response As String
Debug.Print strRequest
XMLhttp.Open "PUT", strURL, False
XMLhttp.setrequestheader "Content-Type", "application/json;charset=UTF-8"
XMLhttp.sEnd strRequest
response = XMLhttp.responseText
Debug.Print response
End Sub
This sends exactly the same stringified JSON, and it gets added to the Firebase database, however, the JSON string doesn't get parsed:
I have tried different Content Types, and variations on the JSON string, but nothing seems to work. Can anyone explain how I can get the VBA script to send data that Firebase will parse?
Thanks
I found a possible solution to sending JSON data from excel to firebase, but it doesn't answer my question about why the above VBA code sending a Stringified JSON doesn't get parsed in Firebase. I would still like a solution to that, because I already have a function the creates the stringified JSON from my data.
Using the VBA-web Library from this Stack Overflow post seems to do the trick. The example uses dictionaries for your data, however please my comment and the subsequent reply regarding the format of the JSON string to send. No escape code is required!
There is no PUT, and Other request types for json, but you can easily add these in yourself.
The equivalent code to the above, but using VBA-web library (with custom PutJson function) is:
Sub test()
Dim strURL As String: strURL = "https://<database-name>/rest/test/whatwhat/.json"
Dim strRequest As String: strRequest = "{""LastName"":""Jones"",""firstName"":""Bubba""}"
Dim Client As New WebClient
Dim Response As WebResponse
Set Response = Client.PutJson(strURL, strRequest)
ActiveSheet.Range("A1").Value = Response.Content
End Sub
And we end up with this....
Happy Days!
However, I'd still like to know why the seemingly identical curl and VBA HTTP requests result in different parsing of the data in FireBase?

VBA JSON POST Payload Issue

I'm trying to setup a API request to pull data from the Bureau of Labor Statistics. I succeeded in getting data using a get request, entering just the url and the series (as shown in the first code example). This works fine and I was able to parse out the JSON using Tim Hall's VBA-JSON converter and work with the data. My problem is that the get method returns only 3 years of data and I'd like to get more than that which requires a post method.
Sub GetCPItable()
Dim objhttp As Object
Dim strUrl As String
strUrl = "https://api.bls.gov/publicAPI/v1/timeseries/data/CUUR0000SA0"
Set objhttp = CreateObject("MSXML2.XMLHTTP")
With objhttp
.Open "get", strUrl, False
.Send
End With
MsgBox objhttp.ResponseText
End Sub
It seems (take this with a grain of salt, this is my first time working with api servers) like VBA is not passing my payload. I've checked my payload here and the JSON syntax appears correct and seems to be the correct syntax according to the page I first linked to. Yet the only things I recieve back from the api server is 404 not found errors. I've been trying different things to piece together what I'm missing all day from their source code examples (no VBA ofcourse) and posts here and elsewhere on the web and haven't made any progress. Here is a debugging version of the code that isn't working.
Sub GetCPItable()
Dim objhttp As Object
Dim body As String
'create our URL string and pass the user entered information to it
Dim strUrl As String
strUrl = "https://api.bls.gov/publicAPI/v1/timeseries/data"
Set objhttp = CreateObject("MSXML2.XMLHTTP")
With objhttp
.Open "POST", strUrl, False
.SetRequestHeader "Content-type", "application/json"
body = "{""seriesid"":""CUUR0000SA0""],""startyear"":""2008"",""endyear"":""2012""}"
.Send (body)
End With
MsgBox objhttp.ResponseText
End Sub
This is the error I get in response:
: responseText : "{
"status": "REQUEST_FAILED",
"responseTime": 0,
"message": [
"404 Error - Page Not Found"
],
"Results": [ ]
}" : String
Any help would be much appreciated. The only thing I can think to try next is using the V2 API but I'd like to avoid that if possible since it would require yearly reregistration.

XMLHTTP is pulling HTML from parent webpage

I am trying to pull historical weather data from wunderground- originally I tried to scrape the web data off the main webpage using the standard HTML elements etc. etc.. however then I discovered that if you add "?format=1" to the URL a browser will display more or less a csv which is much easier to parse into data tables...
However I was still using IE browser which can be quite slow if you have a lot of data to pull so I started looking into using an XMLHTTP object to help pull the data faster which is where I ran into my issue- as I mentioned adding "?format=1" to the end of the URL would return a nice slim csv, but when I use the XMLHTTP it pulls the HTML of the original page not the CSV!
It seems to me like when the XMLHTTP sends its request, the response comes back from the 'parent' site if you will and not the csv that I specified... I noticed that it pulls the HTML from the URL that ends in .html, like it cuts off at .html and that's why the response is from the .html page and not the CSV page.. so I tried looking into URL protocols to see if there was a way to force the XMLHTTP to request the csv URL but I am pretty far out of my element and couldn't find anything..
Code below- appreciate any help you can give me:
Public Sub downloadWebDataToCSV(URL As String)
Dim ADOStream As ADODB.Stream
Dim XMLHTTP As MSXML2.XMLHTTP60
Set XMLHTTP = New MSXML2.XMLHTTP60
XMLHTTP.Open "GET", URL, False
XMLHTTP.send
If XMLHTTP.Status = 200 Then
Set ADOStream = New ADODB.Stream
With ADOStream
.Open
.Type = adTypeBinary
.Write XMLHTTP.responseBody
.SaveToFile "C:\datafile.csv", 2
.Close
End With
End If
End Sub
Here are the parent and csv URLs as well if that helps-
Mainpage: https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html
CSV:
https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html?format=1
Thanks in advance,
TheSilkCode
I think you need to change the encoding of what is returned, then you can write directly to a CSV after cleaning up the format a bit. To change the format, you need to set a few request headers. See below.
Public Sub downloadWebDataToCSV()
Dim URL As String: URL = "https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html?format=1"
Dim XMLHTTP As New MSXML2.XMLHTTP60
With XMLHTTP
.Open "GET", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
.setRequestHeader "content-type", "text/html; charset=UTF-8"
.send
End With
If XMLHTTP.Status = 200 Then
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object: Set Fileout = fso.CreateTextFile("C:\users\megatron\desktop\vba.txt")
Dim myText As String: myText = Replace(XMLHTTP.responseText, "<br />", vbCrLf)
Fileout.Write myText
Fileout.Close
End If
End Sub
You can get the data via Weather API by the example URL:
http://api.wunderground.com/api/c991975b7f4186c0/history_20031015/q/airport/KDAL.json
As you can see, the URL consists of three variable parts: API key c991975b7f4186c0, date 20031015 and location airport/KDAL. If you make XHR the response returns in JSON format.
How to obtain API key and parse JSON respons you can see in this answer.
Read more about Weather API.

Post JSON to web in excel vba

I want to POST some JSON with some VBA:
Dim sURL As String, sHTML As String, sAllPosts As String
Dim oHttp As Object
Dim blWSExists As Boolean
Set oHttp = CreateObject("MSXML2.XMLHTTP")
sURL = "some webste.com"
oHttp.Open "POST", sURL, False
oHttp.setRequestHeader "Content-type", "application/json"
oHttp.setRequestHeader "Accept", "application/json"
oHttp.Send (mType = OPEN_SYSTEM_TRADE & systemOwnerId = 10)
sHTML = oHttp.ResponseText
Worksheets("Open1").Range("A1").Value = sHTML
The predefined format to be sent to the website is a description in json as follows :
{"mType":"OPEN_SYSTEM_TRADE","systemOwnerId":10,"systemId":16, etc}
My oHttp.Send line must be wrong, as soon as i add more arguments, i get a compiler error
I publish this (not working) code cause its the best i could find on the web so far (all other get me stuck on other things that i don't understand ...
I also tried to put the json code in a cell, put the cell in a string, and send the string like this : oHttp.Send (string), which results in a Error 406 Not Acceptable reply from the website.
JSON can be very sensitive to how it's formatted, so I would make sure everything is quoted properly before it is sent. I would recommend splitting Body into a separate variable and debugging the value with http://jsonformatter.curiousconcept.com/ before sending.
Dim Body As String
Body = "{""mType"":""OPEN_SYSTEM_TRADE"",""systemOwnerId"":10}"
' Set breakpoint here, get the Body value, and check with JSON validator
oHttp.Send Body
I ran into many similar issues when working with Salesforce's REST API and combined my work into a library that may be useful to you: https://github.com/VBA-tools/VBA-Web. Using this library, your example would look like:
Dim Body As New Dictionary
Body.Add "mType", "OPEN_SYSTEM_TRADE"
Body.Add "systemOwnerId", 10
Dim Client As New WebClient
Dim Response As WebResponse
Set Response = Client.PostJson("somewebsite.com", Body)
Worksheets("Open1").Range("A1").Value = Response.Content