Http request VBA response - vba

Making my first steps on HTTP within VBA.
Already managed to get cookie value in order to make a request. The problem I'm having is that the file I want to download is not in the first response. When I analyse using HTTP Header Live, the browser receives several responses and only the last one is the file, a PDF that is generated after a query sent by the user. The only thing I'm getting is the first response that I'm displaying with a MsgBox. Can someone help me solving this problem. Made some searches through the web but haven't found yet, a solution.
The code I am using is:
Sub Test()
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("WinHTTP.WinHTTPrequest.5.1")
With WinHttpReq
.Open "POST", myURL, False ', "username", "password"
.send
x = .getResponseHeader("Set-Cookie")
i = InStr(x, ";")
x = Left(x, i - 1)
MsgBox x
End With
With WinHttpReq
.Open "GET", myURL, False
.Option(WinHttpRequestOption_EnableRedirects) = True
.SetRequestHeader "Content-Type", "application/pdf"
.SetRequestHeader "Accept-Encoding", "gzip, deflate, br"
.SetRequestHeader "Cookie", x
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:62.0) Gecko/20100101 Firefox/62.0"
.send
End With
MsgBox (WinHttpReq.getAllResponseHeaders())
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Type = 1
.Open
.Write WinHttpReq.responseBody
.SaveToFile "C:\Users\xxx\Desktop\file.pdf", 2
.Close
End With
End If
Set WinHttpReq = Nothing
Set oStream = Nothing
End Sub
Analyzing with Firefox, when I enter the URL, I receive two responses with 200 OK. I wonder how can I get the second response? The site uses a javascript that interprets the query I send and returns a PDF file. The file name changes according to the user and the query.
Now, i reached the following point. I make a first request to get the cookie, then a second to get an ETag from a diferent address. The problem is that when i make the third request to download the file, the filename is apparently generated by the server (APACHE?), based on the ETag and something I'm not being able to find. The last 5 numbers from the ETag change in the filename.
For example:
ETag - 1543932096000
File - 1543932095115.xxxxx.address.com.5245.idp.pdf
Since I don't have the filename, i cannot download the file with an httprequest.
Help?

Related

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

Download file from URL throws status code 406

Hi guys I have this sub I want to download a file from URL but everytime when I run it WinHttpReq.Status contains 406.
Sub DownloadFile()
Dim myURL As String
myURL = "https://YourWebSite.com/?your_query_parameters"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
The 406 status code means that, although the server understood and processed the request, the response is of a form the client cannot understand. A client sends, as part of a request, headers indicating what types of data it can use, and a 406 error is returned when the response is of a type not in that list.
Eg. If you ask the server to send a GIF picture, but it can only send plain text and PNG pictures you will receive a 406 status code meaning your server understood your question but cannot fulfill it.
So you should include an Accept header specifying which type of media you want your server to send to your client (your VBA), and that type should be a type that your server can actually deliver.
Example how to send headers:
WinHttpReq.SetRequestHeader "Content-Type", "text/xml;charset=utf-8"
WinHttpReq.SetRequestHeader "Accept", "text/xml"
Of course nobody can tell you which media type is the correct because we don't know your server and which type of media it can provide.

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

403 Error on HTTP request

I have searched for similar "403" threads but could not find an answer.
I have the following URL which is valid and working -
www.investing.com/equities/apple-computer-inc-earnings
And my code:
Sub GetSourceCode()
Dim XMLHTTP As Object
Dim URL As String
Dim data As String
URL = "http://www.investing.com/equities/apple-computer-inc-earnings"
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", URL, False
XMLHTTP.send
data = XMLHTTP.responseText
End Sub
However, The string "data" is returned with a "403 Forbidden" error instead of the source code, which is what I am trying to achieve.
Any solution or a workaround (or a duplicate reference) would be highly appreciated.
Thanks
set request header just before .send
XMLHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"

#Value error on Winhttp.Winhttprequest in Excel VBA

I have written some code to retrieve url, but i am getting #Value error. Is anything wrong in this code,
Public Function Rurl(ByVal URL As String)
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
http.Option(WinHttpRequestOption_EnableRedirects) = True
If Not InStr(URL, "://") > 0 Then URL = "http://" & URL
http.Open "GET", URL
http.Send
Rurl = http.GetResponseHeader("Location")
Set http = Nothing
End function
You don't say where you're getting the error, so I'm going to assume it's at this line:
Rurl = http.GetResponseHeader("Location")
Something to ask yourself: what will your code do if the site at the supplied URL doesn't redirect?
The answer is that your code will give you an error at the above line which you don't handle anywhere in your code, very likely resulting in the #VALUE! error that you're seeing.
I'd suggest adding some error checking to ensure your function works in all situations. So, give this a go:
Public Function Rurl(ByVal URL As String)
On Error GoTo ErrorHandler
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
http.Option(WinHttpRequestOption_EnableRedirects) = True
If Not InStr(URL, "://") > 0 Then URL = "http://" & URL
http.Open "GET", URL
http.Send
Rurl = http.GetResponseHeader("Location")
Set http = Nothing
Exit Function
ErrorHandler:
Rurl = "" ' or you can say something like: "No redirection".
Resume Next
End Function
If an error occurs anywhere in your function, the error handler will set the return value of your function to something sensible, clean up and exit the function. If no error occurs, everything should work like before. We're just adding a bit of code to handle potential errors.
trap for the 302 status code then get the Location variable from the http header.
strUrl = "https://xx123.abc.com/"
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
With http
.Open "GET", strUrl, False
.setRequestHeader "Content-Type", "text/css" '"application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0"
.Option(WinHttpRequestOption_EnableRedirects) = False
.Send
d = .waitForResponse()
If (.Status = 302) Then
temp = .responseText
headers = .getAllResponseHeaders()
cookie = .getResponseHeader("Set-Cookie")
redirectedURL = .getResponseHeader("Location")
End If
End With