How to download file from secure website with WinHTTPRequest.5.1 - html

I'm trying to download files(PDFs) silently from a website with VBA. So far I login without issue entering UserName & Password on the initial screen, navigate to the reports page within the site, get my list of files successfully in a table. I get the URL of the file in question without issue. Here's where I hit a wall. I do download a file but get a security warning when i open it that I must be logged in to view it. I can simulate this warning by pasting a URL into any browser when I'm not logged in & they look the same. So I'm downloading but not authenticating.
The code just on the download issue:
Dim strCookie As String
Dim strResponse As String
Dim xobj As Object
Dim WinHttpReq As Object
Dim WinHttpReq2 As Object
Dim oStream As Object
' Set xobj = New WinHttp.WinHttpRequest
strDocLink = "https://atlasbridge.com" & strDocLink & "&RT=PREVMAIL"
Debug.Print strDocLink
' launch tab & goto url/doc
' try to download the link(this is the url of the file)
' strDocLink
Set WinHttpReq = CreateObject("WINHTTP.WinHTTPRequest.5.1")
strUrl = "https://atlasbridge.com/search/AgencyReports.aspx"
WinHttpReq.Open "GET", strUrl, False
WinHttpReq.Option(WinHttpRequestOption_EnableRedirects) = False
WinHttpReq.setRequestHeader "Referer", "https://atlasbridge.com/search/AgencyReports.aspx"
WinHttpReq.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
WinHttpReq.setRequestHeader "Connection", "keep-alive"
WinHttpReq.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
WinHttpReq.setRequestHeader "Accept-Language", "en-US,en;q=0.5"
WinHttpReq.Send
If WinHttpReq.Status = 200 Then
strResponse = WinHttpReq.responseText
Debug.Print strResponse
strCookie = WinHttpReq.getResponseHeader("Set-Cookie") ' this only gets the cookie; cookie seems include the session id
resp = WinHttpReq.getAllResponseHeaders
' resp = WinHttpReq.responseBody
' strCookie = WinHttpReq.getResponseHeader("Cookie") ' doesnt find the requested header
Debug.Print strCookie
Debug.Print resp
End If
' then open second session & try to get document
Set WinHttpReq2 = CreateObject("WINHTTP.WinHTTPRequest.5.1")
WinHttpReq2.Open "GET", strDocLink, False
WinHttpReq2.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
WinHttpReq2.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
WinHttpReq2.setRequestHeader "Accept-Language", "en-US,en;q=0.5"
WinHttpReq2.setRequestHeader "Referer", "https://atlasbridge.com/search/AgencyReports.aspx"
WinHttpReq2.setRequestHeader "Connection", "keep-alive"
WinHttpReq2.setRequestHeader "Host", "atlasbridge.com:443" '
WinHttpReq2.setRequestHeader "Accept-Encoding", "gzip, deflate, br"
' WinHttpReq2.setRequestHeader "Transfer-Encoding", "chunked"
' doesnt like this one causes error on the .send
WinHttpReq2.setRequestHeader "Cache-Control", "private"
WinHttpReq2.setRequestHeader "Upgrade-Insecure-Requests", "1"
WinHttpReq2.setRequestHeader "Content-Type", "application/pdf"
WinHttpReq2.setRequestHeader "Cookie", strCookie
WinHttpReq2.Send
If WinHttpReq2.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq2.responseBody
oStream.SaveToFile "C:\Users\MyUserName\Desktop\DownloadedMail\atlasreportdownload.ashx.pdf", 1 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
I've tried a few different things, but I don't believe I'm getting the full cookie & session ID.
The cookie I get back in WinHttpReq.getResponseHeader("Set-Cookie") or getAllResponseHeaders looks like:
NSC_bumbtcsjehf.dpn_TTM_443_MCWT=ffffffffc3a00a0a000000000005e445a4a423660;Version=1;Max-Age=2400;path=/;secure;httponly
But when I use LiveHeaders in Firefox I see:
Cookie: ASP.NET_SessionId=z2e4adilfjgiyynx2mntnh1k; NSC_bumbtcsjehf.dpn_TTM_443_MCWT=ffffffffc3a00a0a000000000005e445a4a423660; AuthToken=0be22946-a97a-442e-bd93-c80f0c96a525; AtlasLastMessage=1173; lc_sso7549731=1546651094987; __lc.visitor_id.7549731=S1546651090.26728e19e6
But I can't seem to expose that full cookie with AuthToken & Session ID, etc. when I Debug.Print the response. Can someone point me in the right direction so I can test a variation on what I'm doing? Thank you in advance.
Update: The response headers from the first request:
Cache-Control: private
Date: Wed, 16 Jan 2019 22:04:54 GMT
Content-Length: 164
Content-Type: text/html; charset=utf-8
Location: /default.aspx?err=Expired&dest=%2fhome.aspx
Server: Microsoft-IIS/7.0
Set-Cookie: ASP.NET_SessionId=mo0owzztbul5of0litxox5kx; path=/; secure; HttpOnly
Set-Cookie: NSC_bumbtcsjehf.dpn_TTM_443_MCWT=ffffffffc3a00a1a45525d5f4f58455e445a4a423660;Version=1;Max-Age=2400;path=/;secure;httponly
X-AspNet-Version: 4.0.30319
X-UA-Compatible: IE=edge
X-Powered-By: ASP.NET
I'm working on downloading the response body now.

Related

Unable to mimic POST request with headers - VBA

I have spent about 15 days trying to make a scraper in VBA, I've been making decent progresses day after day but these last two days I got stuck in the very last step to get the data.
This is a continuation of my previous post, which gave me a good guide to start.
Here's the process I want to simulate usign MSXML (not Internet Explorer)
Open https://beacon.schneidercorp.com/
Select "Iowa State"
Select "Boone County, IA"
Click on the popup link "Property Search"
In the top red ribbon, click on the "Comp Search" label
At the bottom of the resulting page, in the "Agricultural Comparables Search" section check the "Sale Date" checkbox
Select 5 months in the "Sale Date" combobox
Click on the "Search" button at the bottom of the "Agricultural Comparables Search" section
In the resulting page, look for "Parcel ID" identified as "088327354400002" and click on the link on the "Recording" column (value "2020-0418")
I could achieve the first 8 steps but I haven't been able to get URL of the results that should be get from that last link held in "2020-0418"
As I did to get from the 8th to the 9th step, I noticed that inside the Development ToolKit's "Network" Tab, the website sent a POST request, as shown below.
**General**
Request URL: https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=579&Q=1926372975
Request Method: POST
Status Code: 302
Remote Address: 52.168.93.150:443
Referrer Policy: no-referrer-when-downgrade
**Response Headers**
alt-svc: quic=":443"; ma=2592000; v="44,43,39"
cache-control: private
content-encoding: gzip
content-length: 187
content-type: text/html; charset=utf-8
date: Sat, 27 Jun 2020 00:46:42 GMT
location: /Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=551&Q=1603287013
status: 302
vary: Accept-Encoding
**Request Headers**
:authority: beacon.schneidercorp.com
:method: POST
:path: /Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=579&Q=1926372975
:scheme: https
accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed- exchange;v=b3;q=0.9
accept-encoding: gzip, deflate, br
accept-language: es-ES,es;q=0.9
cache-control: max-age=0
content-length: 395
content-type: application/x-www-form-urlencoded
cookie: _ga=GA1.2.1299682399.1590279064; MODULES508=; MODULESVISIBILE508=18469; MODULES1024=; MODULESVISIBILE1024=29489%7C29501; MODULES501=; MODULESVISIBILE501=10310; _gid=GA1.2.449363625.1593013300; ASP.NET_SessionId=4xwgdh2cqto0kugirkani4vp; _gat=1
origin: https://beacon.schneidercorp.com
referer: https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=579&Q=1926372975
sec-fetch-dest: document
sec-fetch-mode: navigate
sec-fetch-site: same-origin
sec-fetch-user: ?1
upgrade-insecure-requests: 1
user-agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.116 Safari/537.36
Query String Parameters (source view)
AppID=84&LayerID=795&PageTypeID=3&PageID=579&Q=1926372975
**Form Data (source view)**
__EVENTTARGET=ctlBodyPane%24ctl02%24ctl01%24gvwAgCompResults%24ctl05%24lnkRecording&__EVENTARGUMENT=&__VIEWSTATE=cbg8zdrx99ofbjcpw9%2FCE8J0v2SY5W86N%2Fbx%2FU0CsnNPy9D3bcg%2F5YstkCGTwd03lObnZbF9%2B5QuO1lP658HYgyXsOmpImGVjhn47teNdO788MngiEN9qzZbzrOv8jZAd93B8QXltxoPV5dLVu0%2BELpETwwTteNsmbKNEr1IpBz2aSxsN1spJUTKy42SUE37HkdUqVpsQlCPHPyIomJH4b6CoepL2uG9y45pMbUYFZxPG5ob&__VIEWSTATEGENERATOR=569DB96F
Next, I show a sample of my code
Sub ScrapingTest()
Dim XMLpagina As New MSXML2.ServerXMLHTTP60
Dim htmlDoc As New MSHTML.htmlDocument
Dim strURL As String, strBodyRequest As String
Dim strETarget As String, strVState As String
Dim strT1 As String, strT2 As String, strT3 As String
Dim strPageID As String, strPageTypeID As String
'====================
'FOR VIEWING PURPOSES I ONLY SHOW A SHORT VERSION OF MY ORIGINAL CODE,
'TRYING TO CUT AS MUCH AS POSSIBLE...
'====================
'OPENING Comp Search Website - STEP 6
strURL = "https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=2&PageID=578"
'SEND GET REQUEST
XMLpagina.Open "GET", strURL, False
XMLpagina.send
htmlDoc.body.innerHTML = XMLpagina.responseText
Call generarCopiaHtml(XMLpagina)
'GETTING THE VALUES TO BE SEND ON THE REQUESTBODY OF THE NEXT REQUEST
'GET THE EVENTTARGET
strETarget = "ctlBodyPane$ctl02$ctl01$btnSearch" 'I DON'T SCRAPE FOR THIS BECAUSE IT'S ALWAYS THE SAME
'GET THE VIEWSTATE VALUE
strT1 = "<input type='hidden' name='__VIEWSTATE' id='__VIEWSTATE' value='"
strT1 = Replace(strT1, "'", """")
strT2 = "' />"
strT2 = Replace(strT2, "'", """")
strVState = extraeVerg(XMLpagina.responseText, strT1, strT2) 'THIS CUSTOM FUNCTION EXTRACTS A TEXT LAYING BETWEEEN strT1 AND strT2
'SETS THE REQUESTBODY
strBodyRequest = "__EVENTTARGET=ctlBodyPane%24ctl02%24ctl01%24btnSearch"
strBodyRequest = strBodyRequest & "&__EVENTARGUMENT="
strBodyRequest = strBodyRequest & "&__VIEWSTATE=" & strVState
strBodyRequest = strBodyRequest & "&__VIEWSTATEGENERATOR=569DB96F"
strBodyRequest = strBodyRequest & "&ctlBodyPane%24ctl02%24ctl01%24chkUseSaleDate=on"
strBodyRequest = strBodyRequest & "&ctlBodyPane%24ctl02%24ctl01%24cboSaleDate=5" 'DEFINES HOW MANY MONTHS THE SEARCH WILL GO THROUGH
strBodyRequest = strBodyRequest & "&ctlBodyPane%24ctl02%24ctl01%24txtSaleDateHigh_VCS3Ag=" & Month(Now) & "%2F" & Day(Now) & "%2F" & Year(Now)
strBodyRequest = strBodyRequest & "&ctlBodyPane%24ctl02%24ctl01%24txtCSRPointsHigh="
'OPENING Comp Search Website(SHOWING RESULTS)- STEP 9
'SEND THE REQUEST
XMLpagina.Open "POST", strURL, False
XMLpagina.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
XMLpagina.setRequestHeader "Content-Length", Len(strBodyRequest)
XMLpagina.send strBodyRequest
'GENERATE A LOCAL COPY OF THE RESPONSE
Call generarCopiaHtml(XMLpagina)
'BUILDING THE URL FOR THE NEXT REQUEST
strT1 = "{'Name':'Comp Results','PageId':"
strT1 = Replace(strT1, "'", """")
strT2 = ",'PageTypeId':"
strT2 = Replace(strT2, "'", """")
strT3 = ",'Icon"
strT3 = Replace(strT3, "'", """")
strPageID = extraeVerg(XMLpagina.responseText, strT1, strT2)
strPageTypeID = extraeVerg(XMLpagina.responseText, strT1 & strPageID & strT2, strT3)
'THE strURL MUST BE EXACTLY LIKE "https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=579"
strURL = "https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=" & strPageTypeID & "&PageID=" & strPageID
'GETTING THE VALUES TO BE SEND ON THE REQUESTBODY
strT1 = "<input type='hidden' name='__VIEWSTATE' id='__VIEWSTATE' value='"
strT1 = Replace(strT1, "'", """")
strT2 = "' />"
strT2 = Replace(strT2, "'", """")
strVState = extraeVerg(XMLpagina.responseText, strT1, strT2)
'SETS THE REQUESTBODY
strETarget = "ctlBodyPane$ctl02$ctl01$gvwAgCompResults$ctl45$lnkRecording" 'THIS VALUE MIMICS THE CLICK ON THE RECORD "2020-0418" RELATED TO THE PARCEL ID "088327354400002"
strBodyRequest = "__EVENTTARGET=" & Application.WorksheetFunction.EncodeURL(strETarget)
strBodyRequest = strBodyRequest & "&__EVENTARGUMENT="
strBodyRequest = strBodyRequest & "&__VIEWSTATE=" & strVState
strBodyRequest = strBodyRequest & "&__VIEWSTATEGENERATOR=569DB96F"
'SEND THE REQUEST
XMLpagina.Open "POST", strURL, False
XMLpagina.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
XMLpagina.setRequestHeader "Content-Length", Len(strBodyRequest)
XMLpagina.send strBodyRequest
'GENERATE A LOCAL COPY OF THE RESPONSE
Call generarCopiaHtml(XMLpagina)
'ON THIS POINT I SHOULD BE GETTING INSIDE THE "Results" WEBSITE WITH AN URL LIKE THIS
' "https://beacon.schneidercorp.com/Application.aspx?AppID=84&LayerID=795&PageTypeID=3&PageID=551"
'WHICH GIVES A LIST OF THE PARCELS INVOLVED IN THE SALE, BUT IT STILL SHOWS THE LAST PAGE RESULTS...
'I CAN'T SEE WHAT AM I DOING WRONG...
End Sub
My real goal is to repeat this process to get data from some specific sales of all Iowa State Counties, but when I do the first all other won't be a problem.
Can someone show me what am I doing to wrong to make this work?
PS1: I apologize for another question related to the same problem, that I made about ten days ago, which was wrong from top to bottom, I was so tired then that I wrote some crazy stuff.
PS2: Out there seems to be a lot of information about this, but whether I'm not prepared enough to get the solution or my case is not too frequent.

Parse array object inside JSON response

My JSON response:
{"type":"FeatureCollection","totalFeatures":1,"features":[{"type":"Feature","id":"pand3d.6317078","geometry":{"type":"Polygon","coordinates":[[[125290.418,479247.512,0],[125289.696,479248.817,0],[125287.842,479247.791,0],[125264.136,479234.672,0],[125262.123,479233.558,0],[125262.675,479232.56,0],[125281.04,479199.376,0],[125281.226,479199.039,0],[125283.611,479200.359,0],[125286.739,479202.09,0],[125287.237,479202.366,0],[125289.944,479203.864,0],[125290.547,479204.198,0],[125299.388,479209.09,0],[125299.965,479209.409,0],[125302.747,479210.949,0],[125303.148,479211.171,0],[125306.787,479213.185,0],[125308.799,479214.298,0],[125308.765,479214.36,0],[125290.418,479247.512,0]]]},"geometry_name":"geovlak","properties":{"gid":6317078,"identificatie":"0363100012148538","aanduidingrecordinactief":false,"aanduidingrecordcorrectie":0,"officieel":false,"inonderzoek":false,"documentnummer":"GV00000406","documentdatum":"2010-09-09Z","bouwjaar":"2005-01-01Z","begindatumtijdvakgeldigheid":"2010-09-08T22:00:00Z","einddatumtijdvakgeldigheid":null,"gemeentecode":"0363","ground-0.00":-3.64,"ground-0.10":-0.9,"ground-0.20":-0.89,"ground-0.30":-0.88,"ground-0.40":-0.88,"ground-0.50":-0.87,"roof-0.25":27.52,"rmse-0.25":1.09,"roof-0.50":27.57,"rmse-0.50":1.09,"roof-0.75":29.91,"rmse-0.75":1.08,"roof-0.90":30.24,"rmse-0.90":1.08,"roof-0.95":30.35,"rmse-0.95":1.08,"roof-0.99":30.36,"rmse-0.99":1.08,"roof_flat":false,"nr_ground_pts":3515,"nr_roof_pts":6432,"ahn_file_date":"2014-02-01T23:00:00Z","ahn_version":3,"height_valid":true,"tile_id":"25gz2","bbox":[125262.123,479199.039,125308.799,479248.817]}}],"crs":{"type":"name","properties":{"name":"urn:ogc:def:crs:EPSG::28992"}},"bbox":[125262.123,479199.039,125308.799,479248.817]}
I want to parse ["roof-0.99":30.36] from the {properties} object, which is in an array [features], but getting an error of "Invalid arguments"
Here is my attempt
Sub BAG3D()
Dim ws As Worksheet: Set ws = Blad1
'Variabeles for function
Dim BAG3D As Object
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", "http://3dbag.bk.tudelft.nl/data/wfs?SERVICE=WFS&REQUEST=GetFeature&TYPENAMES=BAG3D:pand3d&CQL_FILTER=identificatie=%270363100012148538%27&outputFormat=json", False
' objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
' objHTTP.setRequestHeader "Accept", "application/hal+json"
' objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
' objHTTP.setRequestHeader "X-Api-Key", KEY
objHTTP.send
Set BAG3D = ParseJson(objHTTP.responseText)
Debug.Print objHTTP.responseText
For Each Item In BAG3D("features")(0)("0")("properties")
'Look for "roof-0.99" and get value
ws.Range("Y3").Value = BAG3D("roof-0.99") 'probably not right
Next
End Sub
What should I modify in my parser to properly parse this roof-0.99 into my spreadsheet?
Sub BAG3D()
Dim ws As Worksheet: Set ws = Blad1
'Variabeles for function
Dim BAG3D As Object
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", "http://3dbag.bk.tudelft.nl/data/wfs?SERVICE=WFS&REQUEST=GetFeature&TYPENAMES=BAG3D:pand3d&CQL_FILTER=identificatie=%270363100012148538%27&outputFormat=json", False
' objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
' objHTTP.setRequestHeader "Accept", "application/hal+json"
' objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
' objHTTP.setRequestHeader "X-Api-Key", KEY
objHTTP.send
Set BAG3D = ParseJson(objHTTP.responseText)
Debug.Print objHTTP.responseText
ws.Range("Y3").Value = BAG3D("features")(1)("properties")("roof-0.99")
End Sub

USGA - GHIN 2nd Page Information - Get The Info from a 2nd web page after an XML log in

I got excellent help from "asmitu" who helped me log-in to the USGA GHIN site with the following code. However, my real end problem was to log-In and then maneuver to this 2nd URL (“https://www.ghin.com/golfer-lookup/following“) to extract my data that is stored on the 2nd URL page. Is there a way to modify the code below so that I land on the 2nd page after login?
Sub GHIN_Login()
Const Url = "https://api2.ghin.com/api/v1/public/login.json?"
Dim Http As New XMLHTTP60, ghinNum$, lastName$
ghinNum = "" 'put your ghinNum here
lastName = "" 'put your lastName here
With Http
.Open "GET", Url & "ghinNumber=" & ghinNum & "&lastName=" & lastName & "&remember_me=false", False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/80.0.3987.163 Safari/537.36"
.setRequestHeader "Referer", "https://www.ghin.com/login"
.send
End With
MsgBox Http.responseText
End Sub
The content of that target page generates dynamically, so you can't parse the required fields using xhr. However, the following attempt should lead you grab the json response having required fields within it.
Sub GetInformation()
Const Url = "https://api2.ghin.com/api/v1/public/login.json?"
Const Link = "https://api2.ghin.com/api/v1/followed_golfers/"
Dim Http As New XMLHTTP60, ghinNum$, lastName$
ghinNum = ""
lastName = ""
With Http
.Open "GET", Url & "ghinNumber=" & ghinNum & "&lastName=" & lastName & "&remember_me=false", False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/80.0.3987.163 Safari/537.36"
.setRequestHeader "Referer", "https://www.ghin.com/login"
.send
.Open "GET", Link & ghinNum & ".json", False
.send
End With
MsgBox Http.responseText
End Sub

Post Request in VB.NET doesn't work properly

I want to execute this request with cookies that I have saved in file(cookies are good because i can execute other requests to page)
http://www.banggood.com/index.php?com=event&t=recordSignInShare&fb_id=197203087314503_251208398580638&code=
Yes, last parameter should be empty.
When I open it in browser it gives me json data (no matter how they look)
but when i try to do the same request on vb.net app it redirects me to another page.
Here is code from VB:
Dim postData As String = "com=event&t=recordSignInShare&fb_id=197203087314503_251208398580638&code="
Dim bytes() As Byte = ASCIIEncoding.UTF8.GetBytes(postData)
Dim postReq As HttpWebRequest = WebRequest.Create("http://www.banggood.com/index.php")
postReq.Method = "POST"
postReq.KeepAlive = True
postReq.CookieContainer = cookies
'postReq.ContentType = "application/x-www-form-urlencoded; charset=UTF-8"
postReq.Referer = "http://www.banggood.com/"
postReq.UserAgent = "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/49.0.2623.87 Safari/537.36"
postReq.ContentLength = bytes.Length
Dim postStream As Stream = postReq.GetRequestStream()
postStream.Write(bytes, 0, bytes.Length)
postStream.Close()
Dim postResponse As HttpWebResponse
postResponse = postReq.GetResponse()
cookies.Add(postResponse.Cookies)
Dim reader As New StreamReader(postResponse.GetResponseStream())
Dim strSource As String = reader.ReadToEnd
Return strSource
And it returns me html code, not json data :(
This is how looks request from network monitor when i open it by browser
Request:
Accept:application/json, text/javascript, */*; q=0.01
Accept-Encoding:gzip, deflate, sdch
Accept-Language:pl-PL,pl;q=0.8,en-US;q=0.6,en;q=0.4
Connection:keep-alive
Host:www.banggood.com
Referer:http://www.banggood.com/2016midyear.html?utmid=796
User-Agent:Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.84 Safari/537.36
X-Requested-With:XMLHttpRequest
Response:
Cache-Control:max-age=0, no-cache, no-store
Connection:keep-alive
Content-Length:94
Content-Type:text/html; charset=utf-8
I think that original(from code) request/response headers aren't important because I can execute it proper just by opening this link in browser.
Problem was, that i need get request :P
Thanks the_lotus
Dim urlphp As String = "" & dominio & "" & carpetanoti & "/demanda_alta.php"
Dim Conexion As HttpWebRequest = CType(WebRequest.Create(urlphp), HttpWebRequest)
Conexion.Method = "POST"
Conexion.ContentType = "application/x-www-form-urlencoded"
Dim POST_DATA As String = ("&cTitulo=" & "Te necesitamos!!" & "&cMensaje=" & "ALTA DEMANDA TENEMOS DOMICILIOS PARA TI" & "")
Dim byteArray() As Byte = Encoding.UTF8.GetBytes(POST_DATA)
Conexion.ContentLength = byteArray.Length
Dim FLUJO As Stream = Conexion.GetRequestStream()
FLUJO.Write(byteArray, 0, byteArray.Length)
FLUJO.Close()
Dim Response As HttpWebResponse = Conexion.GetResponse()
FLUJO = Response.GetResponseStream()
Dim LEER As New StreamReader(FLUJO)
Dim ServerResponse As String = LEER.ReadToEnd()
LEER.Close()
FLUJO.Close()
Response.Close()

VBA XMLHTTP query returning 403 error

I am currently attempting to retrieve a json string using XMLHTTP in VBA from the website url detailed below. Loading the first url creates a session, which I retrieve from the HTML body. A call to the second url, using the session ID & other request headers visible from develop tools results in a 403 error. I have tried multiple combinations of headers with no effect. For deployment purposes a VBA solution is required. Any input/ideas would be much appreciated.
Sub test()
Dim wbk_TB As Workbook
Dim var_array As Variant
Dim url As String
Dim data As Variant
Dim XMLHTTP As MSXML2.XMLHTTP
Dim hdoc As MSHTML.HTMLDocument
Set wbk_TB = ThisWorkbook
Set XMLHTTP = New MSXML2.XMLHTTP
url = "http://www.eex-transparency.com/homepage/power/germany/production/availability/non-usability"
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Accept", "application/json, text/plain, */*"
XMLHTTP.send
data = XMLHTTP.responseText
Dim HTMLdoc As MSHTML.HTMLDocument
Set HTMLdoc = New MSHTML.HTMLDocument
HTMLdoc.body.innerHTML = XMLHTTP.responseText
Name = "session=" & HTMLdoc.getElementsByName("session").Item(0).Value
url = "http://www.eex-transparency.com/dsp/tem-12?country=de&limit=50&offset=50"
XMLHTTP.Open "GET", url, True
XMLHTTP.setRequestHeader "Host", "www.eex-transparency.com"
XMLHTTP.setRequestHeader "Proxy-Connection", "keep-alive"
XMLHTTP.setRequestHeader "Accept", "application/json, text/plain, */*"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/36.0.1985.143 Safari/537.36"
XMLHTTP.setRequestHeader "Referer", "http://www.eex-transparency.com/homepage/power/germany/production/availability/non-usability"
XMLHTTP.setRequestHeader "Accept-Encoding", "gzip,deflate,sdch"
XMLHTTP.setRequestHeader "Cache-Control", "max-age=0"
XMLHTTP.setRequestHeader "Accept-Language", "en-US,en;q=0.8"
XMLHTTP.setRequestHeader "Cookie", Name
XMLHTTP.send
While XMLHTTP.readyState <> 4
DoEvents
Wend
data = XMLHTTP.responseText
End Sub
XMLHttp object does not allow unsafe header settings including spoofed referer header. Details are available in this answer
As the referer header is missing in the request, a status 403 is returned. In case you need to get the JSON from VBA, you would need to use an Internet Explorer object and browse to the first URL and once that is loaded, need to navigate to the Second URL by programatically emulating a click on the correct link and then try to capture the data.