Excel VBA MSXML2 Post response body empty runtime error -2147467260 - vba

I would like to post data to Jira using this method :
Private IEService As New MSXML2.XMLHTTP60
Public Function httpPOST(baseUrl As String, url As String, jsonInput As String, auth As String) As String
Dim accept As String
accept = "application/json"
With IEService
.Open "POST", baseUrl & url, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", accept
.setRequestHeader "Authorization", "Basic " & auth
.setRequestHeader "Origin", baseUrl
.send jsonInput
httpPOST = .responseText
'MsgBox (.responseText)
End With
End Function
Data is fine and the POST is executed on the back end side. But Jira in this instance returns an empty response body.
When this happens VBA crashes on .send jsonInput with error : runtime error -2147467260
Seems like MSXML2 does not handle empty responses. But I haven't found anyone facing same issue searching on the web.
Any ideas what I am doing wrong or how to fix it ?
Thanks

Related

How to send a GET request with a body using VBA?

I want to retrieve some data from an API using an GET request. The API takes one parameter encoded as JSON in the body of the request. The following code works fine for sending a POST request with some JSON data however if the type of the request is changed to GET the final request being sent contains no body:
Dim strJSONText As String, strURL As String
strURL = "https://<domain>/<some>/<path>"
strJSONText = "{'<parameter>':'<value>'}"
Set objXMLhttp = CreateObject("Msxml2.XMLHTTP")
objXMLhttp.Open "GET", strURL, False
objXMLhttp.setRequestHeader "Accept", "application/json"
objXMLhttp.setRequestHeader "Content-Type", "application/json"
objXMLhttp.send (strJSONText)
Why is strJSONText being ignored whenever the request type is GET? How do I send a GET request with a body using VBA?

Create Sharepoint folder from VBA (access 2016)

I have an access 2016 app that currently creates a folder on a shared drive related to the DB record the user is working on.
We are migrating to SP online and I need to re-create something similar
I can list the files and folders currently in a directory using the API but when I try and create a new folder I am getting an error
"{"error":{"code":"-2130575251, Microsoft.SharePoint.SPException","message":{"lang":"en-US","value":"The security validation for this page is invalid and might be corrupted. Please use your web browser's Back button to try your operation again."}}}"
The only thing I can see I am doing differently is I am not including a Authorization: "Bearer " + accessToken header in the post.
I haven't been including it in the gets for the Files list and it is working using the cached credentials from IE.
Getting the file and folder like this is working
'create XML HTTP object
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
With objXMLHTTP
'open connection to site
.Open "GET", url, False
'.send
.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
.setRequestHeader "Accept", "application/json"
.send
Do Until .ReadyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
Dim Json As Object
Set Json = JsonConverter.ParseJson(sJSONString)
Debug.Print JsonConverter.ConvertToJson(Json, Whitespace:=2)
Dim value As Dictionary
For Each value In Json("value")
Debug.Print "> " + value("Name")
Next value
However trying to create a folder fails
strPostData = "{ '__metadata': { 'type': 'SP.Folder' }, 'ServerRelativeUrl': '/Shared Documents/Folder1'}"
'Set objXMLHTTP = New MSXML2.XMLHTTP
With objXMLHTTP
.Open "POST", url, False
.setRequestHeader "accept", "application/json;odata=verbose"
.setRequestHeader "Content-Type", "application/json;odata=verbose"
.send strPostData
strResponse = .responseText
End With
Can anyone advise if what I am trying is possible and if so what I am doing is wrong?
Sorry, almost immediately I found and answer!
Needed to add
.setRequestHeader "X-RequestDigest", digest
.setRequestHeader "Content-Length", Len(strPostData)
and it all started working!
Thanks anyway, hope this helps someone else

Token authentication for CURL in EXCEL VBA

A client requested that I put together a tool to take a company domain name and somehow come up with the account name. I found an API that I can work with, but I'm not as familiar with doing this in VBA.
Here is the CURL procedure that the site documentation gives to push through a Domain Name, and receive the company name as a response:
curl 'https://company.clearbit.com/v2/companies/find?domain=segment.com' \
-u sk_b3b05a8924c4f3df86248b4e38421cfa:
After several attempts of receiving the "Please authenticate your request", I've finally gotten to the point where I am receiving an error from the API, I think indicating that I am now correctly calling the API in some way.
Here is my current code. Any idea why I may be receiving this error?
{"error":{"type":"api_error","message":"Sorry, something went wrong. We have been notified."}}
Public Function CallRestAPI2(strUrl1 As String)
TargetURL = "https://company.clearbit.com/v2/companies/find?domain=toplinegroup.com"
Set HTTPReq = CreateObject("WinHttp.WinHttpRequest.5.1")
'HTTPReq.Option(4) = 13056 '
HTTPReq.Open "GET", TargetURL, False
HTTPReq.SetRequestHeader "Content-Type", "application/json"
HTTPReq.SetRequestHeader "Accept", "application/json"
HTTPReq.Send "-u sk_b3b05a8924c4f3df86248b4e38421cfa"
Debug.Print HTTPReq.responseText
End Function
Any idea what I am doing wrong?
Figured this out after more reading in the documentation and it was due to not passing the Authentication header the correct way. Here is my code:
Public Function CallRestAPI3(strUrl1 As String)
Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String
myurl = "https://company.clearbit.com/v2/companies/find?domain=toplinegroup.com"
xmlhttp.Open "GET", myurl, False
xmlhttp.setRequestHeader "Authorization", "Bearer " + "sk_b3b05a8924c4f3df86248b4e38421cfa"
xmlhttp.Send
Debug.Print (xmlhttp.responseText)
End Function

VBA HTTP response text does not support Japanese

I have a VBA program that sends REST API request and get response.
I use WinHttp.WinHttpRequest to send request but the response text does not support Japanese.
It means if REST server returns result with Japanese, HTTP response text in VBA will be strange characters (e.g. ?aa??a).
I tried to SetRequestHeader with Accept-Language = ja-JP, Charset = UTF-8...but it does not work.
Please help me to resolve this problem.
My code here:
Dim oHttp As WinHttp.WinHttpRequest
Set oHttp = New WinHttp.WinHttpRequest
oHttp.Open "GET", "url", False
oHttp.SetRequestHeader "Accept", "application/json"
oHttp.SetRequestHeader "Content-Type", "application/json"
oHttp.SetRequestHeader "Authorization", "Bearer <token>")
oHttp.Send (sData)
Debug.Print oHttp.ResponseText
Thanks
I found a solution for that: use ServerXMLHTTP instead of WinHttpRequest.

POST request created in vba brings back nothing as result

I've written a very tiny script in vba using POST request. However, when I run it, I get nothing as result except for a blank message. I've tried to fill in the request parameter accordingly. Perhaps, I can't notice which should be included in the parameter. The page I'm dealing with contains several images in it's right panel. When an image is clicked the request about which i'm talking here is sent to the server and brings back the result and displays new information concerning its' flavor under it. My goal is to parse all the flavors connected to each images. Anyways, I'm trying to attach all the things necessary to find out what i'm missing. Thanks in advance.
This is what I got from chrome developer tools to prepare the POST request:
"https://www.dropbox.com/s/zjn0ahixhu58miq/RequestStatus.txt?dl=0"
Here is what I'm trying with:
Sub PostReq()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim ArgumentStr As String
ArgumentStr = "opt=flavor&opt1=207&opt2=47&ip=105"
With http
.Open "POST", "https://www.optigura.com/product/ajax/details.php", False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.115 Safari/537.36"
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.send ArgumentStr
html.body.innerHTML = .responseText
End With
MsgBox http.responseText
End Sub
This is the original link to the webpage:
"https://www.optigura.com/uk/product/gold-standard-100-whey/"
Your code sets a request header like so:
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
so the script is going to expect the argument string to be URL encoded (which it isn't).
Try either encoding the string, or send the request using "GET" instead.
Finally, I've made it. To receive the required response it is necessary to send a GET request first then again send a POST request using the response from that get request. Here is the working one:
Sub httpPost()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim ArgumentStr As String
ArgumentStr = "opt=flavor&opt1=207&opt2=47&ip=105"
With http
.Open "GET", "https://www.optigura.com/uk/product/gold-standard-100-whey/", False
.send
End With
With http
.Open "POST", "https://www.optigura.com/product/ajax/details.php", False
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.send ArgumentStr
html.body.innerHTML = .responseText
End With
MsgBox http.responseText
End Sub