Empty response of an HTTP post request in VBA - vba

I am trying a make an HTTP post request in VBA but getting an empty response.
Here is my code:
Sub User()
On Error Resume Next
Dim HTTPreq As WinHttpRequest
Set HTTPreq = New WinHttpRequest
URL = "https://www.transfermarkt.com/site/DropDownWettbewerbe"
HTTPreq.Open "POST", URL, False
HTTPreq.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.3) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/55.0.2883.87 UBrowser/7.0.185.1002 Safari/537.36"
HTTPreq.send "land_id=189"
MsgBox (HTTPreq.responseText)
End Sub
I have done the same thing in Python and get the expected response:
<pre><option value="">Competition</option><option value="GB1">Premier League</option><option value="GB2">Championship</option><option value="GB3">League One</option><option value="GB4">League Two</option><option value="CNAT">National League</option><option value="GB21">Premier League 2</option><option value="GB18">U18 Premier League</option><option value="GBFL">EFL Trophy</option><option value="FAC">FA Cup</option><option value="CGB">EFL Cup</option><option value="GBCS">Community Shield</option><option value="FAYC">FA Youth Cup</option>.
Not sure where I am wrong doing this in VBA.

You need to specify content-type header, the below code works fine for me:
Sub User()
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "https://www.transfermarkt.com/site/DropDownWettbewerbe", False
.SetRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
.SetRequestHeader "user-agent", "user-agent: Mozilla/5.0 (Windows NT 6.1; Win64; x64)"
.Send "land_id=3"
MsgBox .ResponseText
End With
End Sub
You may find out the necessary headers from a browser developer tools network tab:

Related

Macro gets partial response using serverxmlhttp requests

I'm trying to extract street address along with the builder name from a webpage. When I use xmlhttp60 requests I get those fields accordingly. However, when I go for serverxmlhttp60 requests I get partial response most of the times and as a result the script only prints the street adddress. I used json converter to parse builder name out of json content from that site.
Here is the proof of concept:
Sub GrabPropertyInfo()
Const siteLink$ = "https://www.redfin.com/TX/Austin/604-Amesbury-Ln-78752/unit-2/home/171045975"
Dim oPost As Object, oData As Object, Html As HTMLDocument
Dim jsonObject As Object, jsonStr As Object, propertyMainRaw$
Dim itemStr As Variant, sResp As String, oElem As Object
Dim propertyContainer As Object, propertyMain As Object
Set Html = New HTMLDocument
' With CreateObject("MSXML2.XMLHTTP")
' .Open "GET", siteLink, False
' .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
' .send
' sResp = .responseText
' Html.body.innerHTML = .responseText
' End With
With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.Open "GET", siteLink, True
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
.send
While .readyState < 4: DoEvents: Wend
sResp = .responseText
Html.body.innerHTML = .responseText
End With
Debug.Print "Street address: " & Html.querySelector("h1.homeAddress > .street-address").innerText
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "reactServerState\.InitialContext = (.*);"
.MultiLine = True
Set jsonStr = .Execute(sResp)
End With
itemStr = jsonStr(0).submatches(0)
Set jsonObject = JsonConverter.ParseJson(itemStr)
Set propertyMain = jsonObject("ReactServerAgent.cache")("dataCache")("/stingray/api/home/details/mainHouseInfoPanelInfo")("res")
propertyMainRaw = Replace(propertyMain("text"), "{}&&", "")
On Error Resume Next
Set propertyContainer = JsonConverter.ParseJson(propertyMainRaw)("payload")("mainHouseInfo")("amenitiesInfo")("superGroups")
On Error GoTo 0
If Not propertyContainer Is Nothing Then
For Each oElem In propertyContainer
For Each oPost In oElem("amenityGroups")
If InStr(oPost("groupTitle"), "Building Information") > 0 Then
For Each oData In oPost("amenityEntries")
If InStr(oData("amenityName"), "Builder Name") > 0 Then
Debug.Print "Builder Name: " & oData("amenityValues")(1)
End If
Next oData
End If
Next oPost
Next oElem
End If
End Sub
Using xmlhttp requests, I always get:
Street address: 604 Amesbury Ln #2,
Builder Name: Zach Savage
Using serverxmlhttp requests, I get the following result most of the time:
Street address: 604 Amesbury Ln #2,
How can I get complete response using serverxmlhttp requests?
EDIT:
According to the answer and comments, it is clear that if I scrape browserid from that site using xmlhttp requests and use the value of that browserid as cookie while sending requests using serverxmlhttp, I'll get the desired results. However, The problem is the value of the browserid that I get using xmlhttp requests is sz9u0xmCQKKV9Wu0jRa3Yg whereas I can see this value v-J5D2IUSyqXizI7MG67fQ in page source. How can I get the latter value? This is how I parsed browserid.
Sub FetchBrowserId()
Const siteLink$ = "https://www.redfin.com/TX/Austin/604-Amesbury-Ln-78752/unit-2/home/171045975"
Dim Rxp As Object, browserId As Object, sRes$, cookie$
Set Rxp = CreateObject("VBScript.RegExp")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", siteLink, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/94.0.4606.61 Safari/537.36"
.send
sRes = .responseText
End With
With Rxp
.Global = True
.Pattern = "window.__rfBrowserId=""(.*?)"";"
.MultiLine = True
Set browserId = .Execute(sRes)
End With
cookie = browserId(0).submatches(0)
Debug.Print cookie
End Sub
So the actual question I guess is why there are different responses returned by MSXML2.XMLHTTP and MSXML2.ServerXMLHTTP requests made to the same URL.
MSXML2.XMLHTTP uses WinINet stack and MSXML2.ServerXMLHTTP uses WinHTTP stack. Check WinINet vs. WinHTTP article for more details.
WinINet provide full processing of cookies (BTW IE also rely on it). So the first reason you have different responses is that cookies sent to server may affect flow. It can be easily compared with any service like e. g. Webhook.site. When you make second request with MSXML2.XMLHTTP the webservice logs the cookies which have been accepted from first response.
Also take in account SSL conditions. Make requests to How's My SSL? by MSXML2.XMLHTTP and MSXML2.ServerXMLHTTP, and follow the link in browser (i. e. Chrome) and compare results.

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

How do I receive and send messages through Bot Telegram in Excel VBA?

I wish I could use some macros to send Dashboard summary text over the work Telegram. I know that for me to send by telegram through webhook (GET and POST html) and I researched and found this topic here:
How can I send an HTTP POST request to a server from Excel using VBA?
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://api.telegram.org/bot<token>/METHOD_NAME"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send("")
Replacing < Token > and < Method_name >
https://core.telegram.org/bots/api
However, when I debug the code it locks up excel and does not come back anymore. Any idea what that might be?
It worked when I deployed MSXML2.ServerXMLHTTP to MSXML2.ServerHTTP60.
Sub fff()
Set objHTTP = CreateObject("MSXML2.ServerHTTP60")
URL = "https://api.telegram.org/bot<token>/sendMessage?chat_id="id"&text=test"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
Cells(1, 1).Value = objHTTP.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)"

xmlHttp to download file

Using google chrome i fill in a form and upon pressing the submit button a spreadhsheet automatically starts downloading. I have identified the POST sent to the server but somehow when i send the same request from my script the response is not a file but the original web form. Please see below the request as shown in Chrome :
Remote Address: ****** -- Request URL:* --
Request Method: POST -- Status Code: 200 OK --**
Request Headers
-Accept:text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
-Accept-Encoding:gzip,deflate,sdch
-Accept-Language:en-GB,en-US;q=0.8,en;q=0.6
-Cache-Control:max-age=0
-Connection:keep-alive
-Content-Length:207
-Content-Type:application/x-www-form-urlencoded
-Cookie:JSESSIONID=*******; ssoLang=en
-Host:*******
-Origin:******
-Referer:*******
-User-Agent:Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36
Query String Parameters
Form Data : REQUEST
Response Headers
-Content-Disposition: filename="xxx.xlsx"
-Content-Type:application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
-Date:Sat, 31 May 2014 14:28:25 GMT
-Server:Apache-Coyote/1.1
-Transfer-Encoding:chunked
The response headers I am getting are different :
-Cache-Control: no-cache, no-store
-Date: Sat, 31 May 2014 14:55:38 GMT
-Pragma: no-cache Transfer-Encoding: chunked
-Content-Type: text/html;charset=UTF-8 Expires: Thu, 01 Jan 1970 00:00:00 GMT
-Server: Apache-Coyote/1.1
The script i attempted to do the above is below, can anybody please point out what is wrong here ?
Sub Download_File()
Dim localFile As String, URL As String, request As String
localFile = ThisWorkbook.Path & "\test.xlsx"
URL = ****SENSITIVE***
Dim XMLreq As Object
Set XMLreq = CreateObject("MSXML2.XMLHTTP")
request = ****REQUEST*****
Dim fileNum As Integer, bytes() As Byte
With XMLreq
.Open "POST", URL, False
.setRequestHeader "Host", ****SENSITIVE***
.setRequestHeader "Connection", "keep-alive"
.setRequestHeader "Content-Length", "207"
.setRequestHeader "Cache-Control", "max-age=0"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
.setRequestHeader "Origin", ****SENSITIVE***
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", ****SENSITIVE***
.setRequestHeader "Accept-Encoding", "gzip,deflate,sdch"
.setRequestHeader "Accept-Language", "en-GB,en-US;q=0.8,en;q=0.6"
.setRequestHeader "Cookie", "JSESSIONID=****SENSITIVE***; ssoLang=en"
.send (Escape(request))
While .readyState <> 4: DoEvents: Wend
If .Status = 200 Then
Debug.Print .getAllResponseHeaders
fileNum = FreeFile
Open localFile For Binary Access Write As #fileNum
bytes = .responseBody
Put #fileNum, , bytes
Close #fileNum
Else
MsgBox "XMLhttp POST error " & .statusText & vbCrLf & "Status = " & .Status & vbCrLf & "URL = " & URL
End If
End With
End Sub
Private Function Escape(ByVal URL As String) As String
Dim i As Integer, BadChars As String
BadChars = "<>%=&!##£$^()+{[}]|\;:'"",/?"
For i = 1 To Len(BadChars)
URL = Replace(URL, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
Next i
URL = Replace(URL, " ", "+")
Escape = URL
End Function
This is not a complete answer but more like a comment. I do not have enough reputation to leave a comment.
The response looks like you are redirected to the web form when some checks or authentication fails. Did you check the JSESSIONID cookie? That should be different for each time you logon to the server. Once you manually login and then capture the JSESSIONID cookie (either using Fiddler as Alex mentioned) or by typing javascript:alert(document.cookie); in the browser address bar and pressing enter, you might be able to reuse the same session token.
Also check the content length to ensure that the url-encoded content length matches this value. You can use the composer feature in Fiddler to test POST queries to the server to get the request parameters correct.
BTW, Fiddler installation folder can be copied to a USB stick and used as a portable installation. You might try that as well.
Edit: Looking further, the issue seems to be that the site requires a correct Referer header for sending out the excel file. As unsafe headers like Referer cannot be set for XMLHttp request, this might cause server side authentication failure and it might send you the initial landing page which is the web form here. Check this answer here