I am trying to send a request (POST) to an API using the XMLHTTP.6.0 object.
When running the same procedure in Postman it works like a charm - but when running it in VB over IIS (ASP) the responding server seems to not even receive the authorization headers specified.
Have been trying to figure out why this occurs all day without no luck.
Anyone have av idea why the Authorization header is no retreived by the remote server?
<%
Function ASPPostJSON(url)
Dim objXmlHttp
Set objXmlHttp = Server.CreateObject("Msxml2.XMLHTTP.6.0")
objXmlHttp.Open "POST", url, false, "nouser", "nopwd"
objXmlHttp.setRequestHeader "Accept", "*/*"
objXmlHttp.SetRequestHeader "Authorization", "Basic VGVzdEZpbmFuczpHUTJUR05KUUdFWURNTlJURzQzR0laUldHNVFXR1pSVA=="
objXmlHttp.SetRequestHeader "cache-control", "no-cache"
objXmlHttp.SetRequestHeader "content-length", "26"
objXmlHttp.SetRequestHeader "Content-Type", "application/json"
'send the json string to the API server
objXmlHttp.Send "{""PNR"": 194803234857 }"
'If objXmlHttp.Status = 200 Then
ASPPostJSON = CStr(objXmlHttp.ResponseText)
'end if
'return the response from the API server
Response.write(ASPPostJSON)
Set objXmlHttp = Nothing
End Function
'call the function and pass the API URL
call ASPPostJSON("https://api.testserver.com/v2/person")
%>
Related
Thank you in advance for any help!! First time using api calls. Trying to input an ISBN into a cell the retrieving information from my inventory file located at artofbooks.com Their documentation for their API calls is not that great. This is my code and I am getting a "bad token" error.
sub test
creds = EncodeBase64("{ AOB_AUTH_USER : cottagebooks, AOB_AUTH_PW : xxxxxx }")
isbn = Cells(5, 3).Value
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
URL = "https://www.theartofbooks.com/api/2.0/item=2010101257"
objHttp.Open "GET", URL, False
objHttp.SetRequestHeader "Content-Type", "multipart/form-data"
objHttp.SetRequestHeader "Accept", "application/xml"
objHttp.SetRequestHeader "Authorization:", "Bearer " & creds
objHttp.Send
strResponseStatus = objHttp.Status
strresponsetext = objHttp.ResponseText
strresponsetext = CStr(strresponsetext)
MsgBox strresponsetext
end sub
Am trying to retrieve data as JSON with the following code, but am just getting an XML response:
Public Sub vbajson()
Dim http As Object
Dim sht As Worksheet
Dim authKey As String
Dim accNr As String
Set sht = Worksheets("Account")
authKey = "abc"
accNr = "123"
Set http = CreateObject("MSXML2.XMLHTTP")
With http
.Open "GET", "https://api.tradier.com/v1/accounts/" & accNr & "/balances", False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Authorization", "Bearer " & authKey
.Send
End With
MsgBox http.responsetext
End Sub
msgbox output:
instead of using
.Open "GET", "https://api.tradier.com/v1/accounts/" & accNr & "/balances", False
I tested the following link, leaving the rest of the VBA code unchanged:
.Open "GET", "http://jsonplaceholder.typicode.com/users", False`
and get the following result, which is the data structure I want:
Am also getting data in JSON structure using the following Python code (code borrowed from here: https://documentation.tradier.com/brokerage-api/accounts/get-account-balance)
import requests
response = requests.get('https://api.tradier.com/v1/accounts/123/positions',
params={},
headers={'Authorization': 'Bearer abc', 'Accept': 'application/json'}
)
json_response = response.json()
print(response.status_code)
print(json_response)
Any idea how I need to update my VBA code to get the data in JSON structure? What is the issue?
I want to get JSON, as xml will no longer be supported once the API gets updated.
Thanks to the help and code from #QHarr I have got the tracking info from Fedex, DHL and Startrack working. I have been trying to use his code and the UPS tracking Web Service Developer Guide and Tracking JSON Developer Guides to get UPS to work as well within Excel. The JSON converter code is from here https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
The code I have tried is as follows
Public Function GetUPSDeliveryDate(ByVal id As String) As String
Dim body As String, json As Object
body = "data={""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":" & Chr$(34) & id & Chr$(34) & ",""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
body = body & "&action=trackpackages&locale=en_AU&version=1&format=json"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://wwwapps.ups.com/WebTracking", False
.setRequestHeader "Referer", "https://www.ups.com/track?loc=en_AU&tracknum=" & id
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send body
Set json = JSONConverter.ParseJson(.responseText)
End With
GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
End Function
I am not getting any errors in the code per-say, but when I use the =GetUPSDeliveryDate() function I am getting a #VALUE! response instead of the delivered date of 7th May 2019, so I am guessing I have got the following bit wrong
GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
I have also tried the following, but no luck.
If json("results")(1)("delivery")("status") = "delivered" Then
GetUPSDeliveryDate = json("results")(1)("checkpoints")(1)("date")
Else
GetUPSDeliveryDate = vbNullString
End If
A sample UPS tracking number is 1Z740YX80140148107
Any help would be greatly appreciated.
Thanks
The following is by mimicking of this UPS tracking site. The json parser used is jsonconverter.bas: Download raw code from here and add to standard module called jsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime.
Option Explicit
Public Sub test()
Debug.Print GetUPSDeliveryDate("1Z740YX80140148107")
End Sub
Public Function GetUPSDeliveryDate(ByVal id As String) As String
Dim body As String, json As Object
body = "{""Locale"":""en_US"",""TrackingNumber"":[""" & id & """]}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://www.ups.com/track/api/Track/GetStatus?loc=en_US", False
.setRequestHeader "Referer", "https://www.ups.com/track?loc=en_US&requester=ST/"
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "DNT", "1"
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json, text/plain, */*"
.send body
Set json = JsonConverter.ParseJson(.responseText)
End With
If json("trackDetails")(1)("packageStatus") = "Delivered" Then
GetUPSDeliveryDate = json("trackDetails")(1)("deliveredDate")
Else
GetUPSDeliveryDate = "Not yet delivered"
End If
End Function
The Tracking Web Service Developer Guide.pdf contains all you need to know to set up using the official tracking API.
set urlname = "https://URL/sso/json/sessions/?_action=validate"
set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlhttp.Open "POST", urlname, false
xmlhttp.setRequestHeader "Content-Type", "application/json"
xmlhttp.setRequestHeader "ms-sso", encryptedTicket
xmlhttp.send
set status = xmlhttp.responseText
response.Write("<script language=javascript>console.log(' statuss : " & status & "'); </script>")
I have above code block:
I am trying to call https URL using POST request
Its just basically decrypt the token (ms-sso) and gives GUID in response.
but I am getting a black response in status code and responseText.
but it works fine if I checked with Fiddler :
POST:"https://URL/sso/json/sessions/?_action=validate"
Content-Type: application/json
ms-sso: AQIC5wM2LY4SfcyB2ttvMve81T42_U1gUOWFv4grmOSRssg.*AAJTSQACMDIAAlNLABM0MTQxMTQ5MjM5MzE3OTA5MTA3AAJTMQACMTI.*
{"valid":true,"uid":"8FC1D617-8E32-45E2-9417-0323491765D2","realm":"/msusers"}
Why this is happening ? any idea?
I know this is similar to some previously asked questions, but something is still not working for me. How can the following command:
curl -X POST --data #statements.json -H "Content-Type: application/json" --user username:password -H "x-experience-api-version: 1.0.0" https://MYLRS.waxlrs.com/TCAPI/statements
be replicated in VBA?
Extra Information:
This relates to a Hosted TIN CAN (xAPI) Learning Record Store called WaxLRS (by SaltBox). The above example comes from here:
http://support.saltbox.com/support/solutions/articles/1000083945-quick
I have an account (free tinkerers account, no CC required to setup) and have generated what I believe to be the required username & password combination. The credentials are termed 'Identifier' & 'Password' and appear under a heading: Basic Authentication Credentials.
No matter what I do I get an error message:
<html>
<head><title>Unauthorized</title></head>
<body>
<h1>Unauthorized</h1>
<p>This server could not verify that you are authorized to
access the document you requested. Either you supplied the
wrong credentials (e.g., bad password), or your browser
does not understand how to supply the credentials required.
<br/>
<!-- --></p>
<hr noshade>
<div align="right">WSGI Server</div>
</body>
</html>
I believe that the example is expecting the JSON payload to be obtained from a file, but I am loading it into a string. I don't expect this to be contributing to the problem, I have compared my string with the example provided using NP++ Compare and it matches.
My code so far is:
url = "https://xxxxxxx.waxlrs.com/TCAPI/statements"
Set pXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1") 'MSXML2.XMLHTTP")
pXmlHttp.Open "POST", url, False
pXmlHttp.setRequestHeader "Content-Type", "application/json"
'pXmlHttp.setRequestHeader "Authorization", "Basic xxxxxxt8wfB6JYerYCz:xxxxxx1FOd29J1s6G2"
pXmlHttp.SetCredentials "xxxxxxt8wfB6JYerYCz", "xxxxxx1FOd29J1s6G2", 0
pXmlHttp.setRequestHeader "x-experience-api-version", "1.0.0"
pXmlHttp.send (stringJSON)
Set pHtmlObj = CreateObject("htmlfile")
pHtmlObj.body.innerHTML = pXmlHttp.responseText
apiWaxLRS = pXmlHttp.responseText
Questions/Answers that helped:
Send a JSON string to a RESTful WS from Classic ASP
https://stackoverflow.com/a/17063741/3451115
How to POST JSON Data via HTTP API using VBScript?
But, I'm still at a loss as to how to replicate the CURL statement in VBA
Try to make basic authorization as shown in the below example:
Sub Test()
sUrl = "https://xxxxxxx.waxlrs.com/TCAPI/statements"
sUsername = "*******************"
sPassword = "******************"
sAuth = TextBase64Encode(sUsername & ":" & sPassword, "us-ascii")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", sUrl, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Basic " & sAuth
.setRequestHeader "x-experience-api-version", "1.0.0"
.send (stringJSON)
apiWaxLRS = .responseText
End With
End Sub
Function TextBase64Encode(sText, sCharset)
Dim aBinary
With CreateObject("ADODB.Stream")
.Type = 2 ' adTypeText
.Open
.Charset = sCharset
.WriteText sText
.Position = 0
.Type = 1 ' adTypeBinary
aBinary = .Read
.Close
End With
With CreateObject("Microsoft.XMLDOM").CreateElement("objNode")
.DataType = "bin.base64"
.NodeTypedValue = aBinary
TextBase64Encode = Replace(Replace(.Text, vbCr, ""), vbLf, "")
End With
End Function