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
Related
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
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.
Update: SOLVED --> Look below for answer.
Update:
At the Microsoft docs i can see that when open method is called with Async=false, the response might not return if "the protocol stack times out", however I have not been able to read up on the timeout timers.
https://learn.microsoft.com/en-us/previous-versions/windows/embedded/ms931177%28v%3dmsdn.10%29
Not really sure if it's related or not.
I'm trying to retrieve a JSON response object through VersionOne query API.
When i try to read the responseText in VBA I receive an empty array, however the exact same request returns correct data from PostMan. I get an HTTP 200 code response, but no data in the response body.
The reason for doing it in VBA and Excel is that the data needs to be analalyzed in a pre-existing Excel model.
I've tried different auth possibilities, both OAUTH and Basic.
This is the VBA code
Option Explicit
Sub Test_LateBinding()
Dim objRequest As Object
Dim strUrl As String
Dim strResponse As String
Dim body As String
Dim strResponseHeaders As String
Dim allResponseHeader As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "https://endpoint"
body = " { ""from"": ""Epic"",""select"": []}"
'with basic'
With objRequest
.Open "GET", strUrl, False, "XXXX", "XXXX"
.SetRequestHeader "Content-Type", "application/json"
.Send body
strResponseHeaders = .StatusText
strResponse = .ResponseText
allResponseHeader = .GetAllResponseHeaders
End With
Debug.Print body
Debug.Print allResponseHeader
Debug.Print strResponse
End Sub
This is my console output:
OK
Content-Type: application/json; charset=utf-8
Content-Length: 2
X-Content-Type-Options: nosniff
V1-MemberID: skatteministeriet/120267
Strict-Transport-Security: max-age=31536000; includeSubdomains
X-Robots-Tag: noindex
VersionOne: Ultimate/19.0.3.29; 0
X-Instart-Request-ID: 3912039762705832388:SEN01-NPPRY25:1553377406:0
[]
This is the PostMan response headers:
PostMan response headers
This is the URL and request JSON body:
URL and request body
SOLVED Finally...
So i found the answer.
After re-analyzing the Postman response i found that the JSON response was actually handed as a gzip encoded response. Which is simply not compatible with the MSXML2.XMLHTTP lib.
So to solve the problem all I did was to use the WinHttp.WinHttpRequest.5.1 lib instead, which is basicly newer. No other changes to the code was needed.
So to others out there using MSXML2.XMLHTTP or the WinHTTPserver.6.0 lib, change to the newer library :)
Option Explicit
Sub Test_LateBinding()
Dim objRequest As Object
Dim strUrl As String
Dim strResponse As String
Dim body As String
Dim strResponseHeaders As String
Dim allResponseHeader As String
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
strUrl = "https://endpoint"
body = " { ""from"": ""Epic"",""select"": []}"
'with basic'
With objRequest
.Open "GET", strUrl, False, "XXXX", "XXXX"
.SetRequestHeader "Content-Type", "application/json"
.Send body
strResponseHeaders = .StatusText
strResponse = .ResponseText
allResponseHeader = .GetAllResponseHeaders
End With
Debug.Print body
Debug.Print allResponseHeader
Debug.Print strResponse
End Sub
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'm trying to get data from one report with VBA in Excel.
I get this error message:
{"data":{"message":"Request method 'GET' not supported","code":3000}}
This is my code:
Dim strUrl As String
strUrl = "https://api.clockify.me/api/workspaces/{workspaceId}/reports/{reportId}/"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.SetRequestHeader "X-api-key", "{api-key}"
.SetRequestHeader "content-type", "application/json"
.Send
End With
'wrap the response in a JSON root tag "data" to count returned objects
Dim response As String
response = "{""data"":" & hReq.ResponseText & "}"
Debug.Print response
Why is the GET method not allowed here?
Looking at the documentation (https://clockify.github.io/clockify_api_docs/#tag-Report)... I don't see a "GET /workspaces/{workspaceId}/reports/{reportId}/" API call - the closes is either GET /reports/{reportId} or PUT/DELETE /workspaces/{workspaceId}/reports/{reportId}, which would explain why you are getting the "GET not allowed", because you can only PUT or DELETE to the /workspaces/{workspaceId}/reports/{reportId}/ endpoint. I'm guessing you want the "GET /reports/{reportId}". Try that.
And I'm guessing this GET /reports/{reportId} isn't under workspaces because reports can be made public... but that's just a guess.