I need help to get authorization to connect to an API. The command line given is
curl -X GET "https://app.mysite.fr/api/v1/societe/11111111" -H "Authorization: Bearer 84dcc64aefabcdefghebcf7762752xx"
Below is my code written in VBA in ms-access
Function GetAuthorization()
Dim objCurlHttp As Object
Dim strResult As String
Dim varReqToken As Variant
Dim strWebServiceUrl As String
Dim strOwnerKey As String
Dim strQry As String
strWebServiceUrl = "https://app.mysite.fr/api/v1/societe/11111111"
strOwnerKey = "84dcc64aefabcdefghebcf776275xx"
Set objCurlHttp = CreateObject("MSXML2.serverXMLHTTP")
With objCurlHttp
.Open "GET", strWebServiceUrl, False
.SetRequestHeader "cache-control", "no-cache"
.SetRequestHeader "Content-type", "application/json"
.SetRequestHeader "Content-type", "Accept"
.SetRequestHeader "Authorization", "Bearer " + strOwnerKey
.Send
strResult = .ResponseText
Debug.Print strResult
End With
Set objCurlHttp = Nothing
End Function
This result is
? GetAuthorization()
Unauthorized
Thanks a lot in advance.
You don't reveal the documentation, but I seriously doubt that it states the Accept header as shown. So try:
.Open "GET", strWebServiceUrl, False
.SetRequestHeader "Content-type", "application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Authorization", "Bearer " + strOwnerKey
Related
In CURL, I can use this line
curl --data 'DataToBeSent' https://example.com/resource.cgi
I am struggling to convert such line to be used in VBA and this is my try till now
Sub POST_Method_Example()
Dim myMessage As String
myMessage = "DataToBeSent"
With CreateObject("MSXML2.ServerXMLHTTP")
.Open "POST", "https://example.com/resource.cgi"
.setRequestHeader "Content-Type", "multipart/form-data; boundary==------------------------d74496d66958873e"
.send sData(myMessage)
Debug.Print .ResponseText
End With
End Sub
But this throws an error at the json response. How can I make this works for VBA?
I can get it work on postman by assigning the url and in Body tab I selected "form-data" and assign KEY: text and VALUE: DataToBeSent
This returns a successful response.
See multipart/form-data for when to use.
Sub POST_Method_Example()
With CreateObject("MSXML2.ServerXMLHTTP")
.Open "POST", "https://example.com/resource.cgi"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send "text=Data to be sent"
Debug.Print .ResponseText
End With
End Sub
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.
I'm working on a API integration on my Excel WorkSheet using VBA and I'm trying to send user input on a cell sent to a RequestHeader in order to find a product on the server
I've tried importing the data directly from the sheet onto a string and then sending that string as the value for the header but I can't seem to get it to work. I'm new to this whole VBA stuff so I don't honestly know if that's possible. Here's what I've tried:
Sub GetCompanyInformation()
Dim hReq As Object, JSON As Dictionary
Dim i As Long
Dim var As Variant
Dim ws As Worksheet
Set ws = Sheet1
'create our URL string and pass the user entered information to it
Dim strUrl As String
strUrl = "My API URL Goes Here"
Dim cod As String
cod = ws.[MYCELL]
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.SetRequestHeader "cache-control", "no-cache"
.SetRequestHeader "data_filter", ""
.SetRequestHeader "data", "products"
.SetRequestHeader "data_id", cod
.Send
End With
[...]
It returns me an empty string. However if I send the request with the same number I add on my cell as such:
[...]
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.SetRequestHeader "cache-control", "no-cache"
.SetRequestHeader "data_filter", ""
.SetRequestHeader "data", "products"
.SetRequestHeader "data_id", "1234"
.Send
End With
It Works, and it returns me the data I need. Am I doing something wrong? Can I get the variable data on a Request Header?
I am trying to use Excel-VBA to perform an https POST of an XML body as follows:
Public Sub test()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim myDom As Object
Set myDom = CreateObject("MSXML2.DOMDocument.6.0")
URL = "https://uatgateway.topl.com.au/quote"
myDom.async = False
myXMLstr = URL & "<?xml version=&Chr(34)&1.0&Chr(34)& encoding=&Chr(34)&UTF-
8&Chr(34)& standalone=&Chr(34)&yes&Chr(34)&?><IMPULSE><REQUEST><QUOTE>
<MERCHANT><ACQUIRERID>Bank A</ACQUIRERID><NETWORKID>eComm</NETWORKID>
<MERCHANTID>987654321</MERCHANTID></MERCHANT><MCH_TRANSACTION>
<QUOTEREF>3456789012</QUOTEREF><MCH_ISO>036</MCH_ISO>
<MCH_AMT>1000.00</MCH_AMT><BIN>400555000</BIN></MCH_TRANSACTION></QUOTE>
</REQUEST></IMPULSE>"
myDom.Load (myXMLstr)
xmlhttp.Open "post", URL, False
xmlhttp.setRequestHeader "Content-Type", "application/xml"
xmlhttp.setRequestHeader "Content-Length", "356"
xmlhttp.setRequestHeader "Accept", "text/xml"
xmlhttp.setRequestHeader "Host", "uatgateway.topl.com.au"
xmlhttp.setRequestHeader "Cache-Control", "no-cache"
xmlhttp.send myDom.XML
MsgBox xmlhttp.responseText
End Sub
My VBA code compiles ok, but on execution stops at the xmlhttp.send line almost immediately with an error "the server returned an invalid or unrecognised response". The same POST on Postman works. I am not sure if I an referencing the myDom.XML correctly?
Any suggestions welcome?
I apologize if my question's title is incorrect - I'm used to the idea of PHP sessions with APIs.
I'm trying to accomplish the same feat in VBA with the following code:
'Login
strLogin = "https://URL.COM/authenticateUser?login=username&apiKey=password"
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", strLogin
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
'Save the response to a string
strReturn = xmlHttp.responseText
'Open URL and get JSON data
strUrl = "https://URL.COM/Search/search?searchTerm=" & Keyword & "&mode=beginwith"
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", strUrl
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
'Save the response to a string
strReturn = xmlHttp.responseText
Sheets(1).Cells(20, 2).Value = strReturn
With this API, I need to login first prior to executing any calls that will return data.
My problem is that I cannot determine how to "stay logged in" so that my second call works.
after I login, strReturn is populated with the following string:
{"Status":{"Code":"2","Message":"Authentication Succeeded","Success":"true"}}
However, when I go to utilize strUrl, I get the following message:
{"Status":{"Code":"1","Message":"Invalid User Name Or Password","Success":"false"}}
I have used this code in prior projects where I needed to supply an API key along with the URL for each request to the server - so this obviously worked fine. I'm not sure how to achieve the concept of "establishing a session" though with xmlHttp.
So, to anyone else who runs across this, the simple solution was to remove the following line from the second call:
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
By not creating a new object, vba is able to keep and use the cookie from the first login call.
The final code looks like this:
'Login
strLogin = "https://URL.COM/authenticateUser?login=username&apiKey=password"
Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xmlHttp.Open "GET", strLogin
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
'Save the response to a string
strReturn = xmlHttp.responseText
'Open URL and get JSON data
strUrl = "https://URL.COM/Search/search?searchTerm=" & Keyword & "&mode=beginwith"
xmlHttp.Open "GET", strUrl
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
'Save the response to a string
strReturn = xmlHttp.responseText
Sheets(1).Cells(20, 2).Value = strReturn
And the API which requires a login is able to keep the session established.