just dial url in not opening in vba get request - vba

url = https://www.justdial.com/Bangalore/Internet-Website-Developers/nct-11035713/page-1
Function getPageContent(ByVal url As String) As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open "GET", url, False
objHTTP.setRequestHeader "Content-Type", "text/xml"
objHTTP.setRequestHeader "Cache-Control", "no-cache"
objHTTP.setRequestHeader "Pragma", "no-cache"
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
objHTTP.send
If objHTTP.Status = 200 Then
getPageContent = objHTTP.responseText
End If
End Function
I am trying to extract justdial webpage but I am not getting the response, Instead i am getting 504 time out error. see my code for any corrections. I am getting response on postman

Please, adapt the function in this way (it needs MSXML2.XMLHTTP60). It needs a reference to 'Microsoft XML, v6.0' - (In VBE - Tools - References, scroll down, check it when found and press 'OK') :
Function getPageContent(ByVal url As String) As String
'It needs reference to 'Microsoft XML, v6.0'
Dim objHTTP As New MSXML2.XMLHTTP60
With objHTTP
.Open "GET", url, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
.send
If .status = 200 Then
getPageContent = .responseText
End If
End With
End Function
Tested it in the next way:
Sub testExtractPage()
Dim url As String
url = "https://www.justdial.com/Bangalore/Internet-Website-Developers/nct-11035713/page-1"
Debug.Print getPageContent(url)'See the result in Immediate Window (Ctrl + G, in VBE)
End Sub

Related

POST Request not working in VBA (XML HTTP)

I am working on xmlHTTP request to extract JSON data from the web.
The below is my code.
Public Sub testlibor2()
Dim JSON As Object
Dim ws As Worksheet, results(), i As Long, s As String
Dim BL As String
Dim mypara As String
Dim mydest As String
Dim URL, URL1, URL2, URL3 As String
URL1 = "draw=1&columns%5B0%5D%5Bdata%5D=0&columns%5B0%5D%5Bname%5D=wdt_ID&columns%5B0%5D%5Bsearchable%5D=true&columns%5B0%5D%5Borderable%5D=true&columns%5B0%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B0%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B1%5D%5Bdata%5D=1&columns%5B1%5D%5Bname%5D=date&columns%5B1%5D%5Bsearchable%5D=true&columns%5B1%5D%5Borderable%5D=true&columns%5B1%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B1%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B2%5D%5Bdata%5D=2&columns%5B2%5D%5Bname%5D=weekday&columns%5B2%5D%5Bsearchable%5D=true&columns%5B2%5D%"
URL2 = "5Borderable%5D=true&columns%5B2%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B2%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B3%5D%5Bdata%5D=3&columns%5B3%5D%5Bname%5D=o&columns%5B3%5D%5Bsearchable%5D=true&columns%5B3%5D%5Borderable%5D=true&columns%5B3%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B3%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B4%5D%5Bdata%5D=4&columns%5B4%5D%5Bname%5D=wdt_column&columns%5B4%5D%5Bsearchable%5D=true&columns%5B4%5D%5Borderable%5D=true&columns%5B4%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B4%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B5%5D%5Bdata%5D=5&columns%5B5%5D%5Bname%5D=wdt_column_1&columns%5B5%5D%5Bsearchable%5D=true&columns%5B5%5D%5Borderable%5D=true&columns%5B5%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B5%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B6%5D%5Bdata%5D=6&columns%5B6%5D%5Bname%5D=1m&columns%5B6%5D%5Bsearchable%"
URL3 = "5D=true&columns%5B6%5D%5Borderable%5D=true&columns%5B6%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B6%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B7%5D%5Bdata%5D=7&columns%5B7%5D%5Bname%5D=wdt_column_2&columns%5B7%5D%5Bsearchable%5D=true&columns%5B7%5D%5Borderable%5D=true&columns%5B7%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B7%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B8%5D%5Bdata%5D=8&columns%5B8%5D%5Bname%5D=3m&columns%5B8%5D%5Bsearchable%5D=true&columns%5B8%5D%5Borderable%5D=true&columns%5B8%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B8%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B9%5D%5Bdata%5D=9&columns%5B9%5D%5Bname%5D=wdt_column_3&columns%5B9%5D%5Bsearchable%5D=true&columns%5B9%5D%5Borderable%5D=true&columns%5B9%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B9%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B10%5D%5Bdata%5D=10&columns%"
URL4 = "5B10%5D%5Bname%5D=wdt_column_4&columns%5B10%5D%5Bsearchable%5D=true&columns%5B10%5D%5Borderable%5D=true&columns%5B10%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B10%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B11%5D%5Bdata%5D=11&columns%5B11%5D%5Bname%5D=6m&columns%5B11%5D%5Bsearchable%5D=true&columns%5B11%5D%5Borderable%5D=true&columns%5B11%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B11%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B12%5D%5Bdata%5D=12&columns%5B12%5D%5Bname%5D=wdt_column_5&columns%5B12%5D%5Bsearchable%5D=true&columns%5B12%5D%5Borderable%5D=true&columns%5B12%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B12%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B13%5D%5Bdata%5D=13&columns%5B13%5D%5Bname%5D=wdt_column_6&columns%5B13%5D%5Bsearchable%5D=true&columns%5B13%5D%5Borderable%5D=true&columns%5B13%5D%5Bsearch%5D%5Bvalue%5D=&column"
mypara = URL1 & URL2 & URL3 & URL4
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://iborate.com/wp-admin/admin-ajax.php?action=get_wdtable&table_id=12", False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36"
.send mypara
Debug.Print .responseText
Set JSON = JsonConverter.ParseJson(.responseText)
End With
End Sub
The code above does not work at all. I cannot receive any JSON data from this.
I have adjusted all the request Headers based on the details from the Chrome dev Tools, and I have
absolutely no Idea what the issue is.
The original URL is as below. I am trying to access the table in the web.
http://iborate.com/usd-libor/
Thank you!
One additional question. Are there any alternatives to dealing with URL strings that are too long to be contained inside one variable? I divided the string as below but I am not sure if this is the best way to handle it.
UPDATE
Based on #QHarr's idea I have changed the Form data into a JSON string. However the code still does not work.
Public Sub testlibor2()
Dim JSON As Object
Dim ws As Worksheet, results(), i As Long, s As String
Dim shipvalue As String, custom As String, MyURL As String
Dim BL As String
Dim mypara, newpara As String
Dim URL, URL1, URL2, URL3, URL4, URL5 As String
URL1 = "{""draw"":""2"",""columns[0][data]"":""0"",""columns[0][name]"":""wdt_ID"",""columns[0][searchable]"":""true"",""columns[0][orderable]"":""true"",""columns[0][search][value]"":"""",""columns[0][search][regex]"": ""false"",""columns[1][data]"": ""1"",""columns[1][name]"": ""date"",""columns[1][searchable]"": ""true"",""columns[1][orderable]"": ""true"",""columns[1][search][value]"": ""|"",""columns[1][search][regex]"": ""false"",""columns[2][data]"": ""2"",""columns[2][name]"": ""weekday"",""columns[2][searchable]"": ""true"",""columns[2][orderable]"":""true"",""columns[2][search][value]"": """","
URL2 = """columns[2][search][regex]"":""false"",""columns[3][data]"":""3"",""columns[3][name]"": ""o"",""columns[3][searchable]"": ""true"",""columns[3][orderable]"": ""true"",""columns[3][search][value]"": """",""columns[3][search][regex]"": ""false"",""columns[4][data]"": ""4"",""columns[4][name]"": ""wdt_column"",""columns[4][searchable]"": ""true"",""columns[4][orderable]"": ""true"",""columns[4][search][value]"": """",""columns[4][search][regex]"": ""false"",""columns[5][data]"": ""5"",""columns[5][name]"": ""wdt_column_1"",""columns[5][searchable]"": ""true"",""columns[5][orderable]"": ""true"",""columns[5][search][value]"": """",""columns[5][search][regex]"": ""false"",""columns[6][data]"": ""6"",""columns[6][name]"": ""1m"",""columns[6][searchable]"": ""true"",""columns[6][orderable]"": ""true"",""columns[6][search][value]"": """",""columns[6][search][regex]"": ""false"",""columns[7][data]"": ""7"",""columns[7][name]"": ""wdt_column_2"",""columns[7][searchable]"": ""true"","
URL3 = """columns[7][orderable]"": ""true"",""columns[7][search][value]"": """",""columns[7][search][regex]"": ""false"",""columns[8][data]"": ""8"",""columns[8][name]"": ""3m"",""columns[8][searchable]"": ""true"",""columns[8][orderable]"": ""true"",""columns[8][search][value]"": """",""columns[8][search][regex]"": ""false"",""columns[9][data]"": ""9"",""columns[9][name]"": ""wdt_column_3"",""columns[9][searchable]"": ""true"",""columns[9][orderable]"": ""true"",""columns[9][search][value]"": """",""columns[9][search][regex]"": ""false"",""columns[10][data]"": ""10"",""columns[10][name]"": ""wdt_column_4"",""columns[10][searchable]"": ""true"",""columns[10][orderable]"": ""true"",""columns[10][search][value]"": """",""columns[10][search][regex]"": ""false"",""columns[11][data]"": ""11"",""columns[11][name]"": ""6m"",""columns[11][searchable]"": ""true"",""columns[11][orderable]"": ""true"",""columns[11][search][value]"": """",""columns[11][search][regex]"": ""false"","
URL4 = """columns[12][data]"": ""12"",""columns[12][name]"": ""wdt_column_5"",""columns[12][searchable]"": ""true"",""columns[12][orderable]"": ""true"",""columns[12][search][value]"": """",""columns[12][search][regex]"": ""false"",""columns[13][data]"": ""13"",""columns[13][name]"": ""wdt_column_6"",""columns[13][searchable]"": ""true"",""columns[13][orderable]"": ""true"",""columns[13][search][value]"": """",""columns[13][search][regex]"": ""false"",""columns[14][data]"": ""14"",""columns[14][name]"": ""wdt_column_7"",""columns[14][searchable]"": ""true"",""columns[14][orderable]"": ""true"",""columns[14][search][value]"": """",""columns[14][search][regex]"": ""false"",""columns[15][data]"": ""15"",""columns[15][name]"": ""wdt_column_8"",""columns[15][searchable]"": ""true"",""columns[15][orderable]"": ""true"",""columns[15][search][value]"": """",""columns[15][search][regex]"": ""false"",""columns[16][data]"": ""16"",""columns[16][name]"": ""wdt_column_9"",""columns[16][searchable]"": ""true"","
URL5 = """columns[16][orderable]"": ""true"",""columns[16][search][value]"": """",""columns[16][search][regex]"": ""false"",""columns[17][data]"": ""17"",""columns[17][name]"": ""12m"",""columns[17][searchable]"": ""true"",""columns[17][orderable]"": ""true"",""columns[17][search][value]"": """",""columns[17][search][regex]"": ""false"",""order[0][column]"": ""1"",""order[0][dir]"": ""desc"",""start"": ""0"",""length"": ""10"",""search[value]"": """",""search[regex]"": ""false"",""wdtNonce"": ""ce62a523fa"",""sRangeSeparator"": ""|""}"
mypara = URL1 & URL2 & URL3 & URL4 & URL5
newpara = Replace(mypara, " ", "")
Debug.Print newpara
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://iborate.com/wp-admin/admin-ajax.php?action=get_wdtable&table_id=12", False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36"
.setRequestHeader "Accept-Encoding", "gzip, deflate"
.send newpara
Debug.Print .responseText
Set JSON = JsonConverter.ParseJson(.responseText)
End With
End Sub
I have checked couple of times to make sure the JSON string is exactly identical as the one suggested below from QHarr.
Can anyone identify a solution from here?

VBa post request from Curl

id have problem with converting the Curl to VBa code what ever i tried the respons is error ,but with postman program i can reach the datat
the Curl code is
curl 'http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi' \ -H 'Connection: keep-alive' \ -H 'Accept: */*' \ -H 'X-Requested-With: XMLHttpRequest' \ -H 'User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.121 Safari/537.36' \ -H 'Content-Type: application/x-www-form-urlencoded; charset=UTF-8' \ -H 'Origin: http://yatirimisletmeleruygulama.kultur.gov.tr' \ -H 'Referer: http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu' \ -H 'Accept-Language: en-US,en;q=0.9,ar;q=0.8' \ -H 'Cookie: __RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1' \ --data-raw 'id=49443&subeid=&__RequestVerificationToken=SOzWMSK-8Snd2SZHALdkktbhKu4tFCp_6arR2mrXwRqsovx2eHxMI0hARoyS0Hw14c0FgJUX5DumXoiNTobgDIhs8vyMSz8sLEq6ZNz7Nyc1' \ --compressed \ --insecure
when i try to wrıte it in VBA like this :
Sub test17() Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String 'xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi" 'myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu" xmlhttp.Open "POST", myurl, False xmlhttp.setRequestHeader "Connection", "keep-alive" xmlhttp.setRequestHeader "Accept", "*/*" xmlhttp.setRequestHeader "X-Requested-With", "XMLHTTP60Request" '"XMLHttpRequest" xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36" xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8" xmlhttp.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr" xmlhttp.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu" xmlhttp.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8" xmlhttp.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1" xmlhttp.setRequestHeader "data-raw", "id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1" RQS = [{"id":"49443","subeid":"","__RequestVerificationToken":"7Q6YVOIyyjyX4K6OvdGdSBpgfOjmS6mm28niZKHp8W0GQX32G8h31nIXj17noMbkSqzxkOOuM7kqpCyqBVkC44GGg-g10109QImOjE6BY801"}] xmlhttp.send RQS 'xmlhttp.send RQS '("id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1") 'MsgBox xmlhttp.responseText Debug.Print xmlhttp.responseText Debug.Print xmlhttp.getAllResponseHeaders End Sub
its give me an erorr where do i do the mistakes
You have to use
Set xmlhttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
instead of 'xmlhttp = CreateObject("Microsoft.xmlhttp")
Pre requisite : in Preference of your project, just add Microsoft winHttp Services, version 5.1
Dim xmlhttp As New MSXML2.XMLHTTP60
Dim myurl As String
Set xmlhttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
myurl = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
xmlhttp.Open "POST", myurl, False
xmlhttp.setRequestHeader "Connection", "keep-alive"
xmlhttp.setRequestHeader "Accept", "*/*"
xmlhttp.setRequestHeader "X-Requested-With", "XMLHTTP60Request"
xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.102 Safari/537.36"
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
xmlhttp.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr"
xmlhttp.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
xmlhttp.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8"
xmlhttp.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1"
xmlhttp.setRequestHeader "data-raw", "id=49443&subeid=&__RequestVerificationToken=gTnyeUJ6DQClZR2x5O31jxReR8hnWiCCnYyEFVYc2C_vXGTwBmHsYYTgN0PrY33giufZJttvmQihd3HZnueSa-Eldu63rN6RBA7spkulbiQ1"
RQS = [{"id":"49443","subeid":"","__RequestVerificationToken":"7Q6YVOIyyjyX4K6OvdGdSBpgfOjmS6mm28niZKHp8W0GQX32G8h31nIXj17noMbkSqzxkOOuM7kqpCyqBVkC44GGg-g10109QImOjE6BY801"}]
xmlhttp.send RQS
MsgBox xmlhttp.responseText
Debug.Print xmlhttp.responseText
Debug.Print xmlhttp.getAllResponseHeaders
its work awesome now
thanx for you all
' bu makro ile siteden post ile veri alýnýr
Dim url As String
Dim data As String
On Error GoTo 10
url = "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/AcenteBilgi"
Dim xhr As New ServerXMLHTTP60
'Dim xhr As Object
'Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
x = 4370 '
y = 4371
Do Until x = Sheet1.Range("b65000").End(3).Row
xhr.Open "POST", url
xhr.setRequestHeader "Connection", "keep-alive"
xhr.setRequestHeader "Accept", "*/*"
xhr.setRequestHeader "X-Requested-With", "XMLHttpRequest"
xhr.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/85.0.4183.121 Safari/537.36"
xhr.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
xhr.setRequestHeader "Origin", "http://yatirimisletmeleruygulama.kultur.gov.tr"
xhr.setRequestHeader "Referer", "http://yatirimisletmeleruygulama.kultur.gov.tr/Acente.Web.Sorgu/Sorgu/acentesorgu"
xhr.setRequestHeader "Accept-Language", "en-US,en;q=0.9,ar;q=0.8"
xhr.setRequestHeader "Cookie", "__RequestVerificationToken_L0FjZW50ZS5XZWIuU29yZ3U1=1RBoSizTRat5E-pETLWXPPcObHrg6vtgsMzUp7Tj9Cx4jhnL-e9gM_0wTBtRPyw_S5BWLjmFmBKlwFSJd80IGzI3TwJxgV3st7z2OdOfAAU1"
IDS = "id=" & Sheet1.Cells(x, 2)
If Sheet1.Cells(x, 3) = Empty Then
subIDs = "&subeid="
Else
subIDs = "&subeid=" & Sheet1.Cells(x, 3)
End If
Tokens = "__RequestVerificationToken=xG794QKU55Viyh-Hn13jgGyp10YyOj5Lph8uTbmKNVKA57Rq9GotGcv4JqmxtIVfvXoVu0P6wNhKAXY4cd2ckuw-8JmUd77_VTetXcl60VQ1"
'data = "id=" & Sheet1.Cells(x, 2) & "&subeid=&__RequestVerificationToken=xG794QKU55Viyh-Hn13jgGyp10YyOj5Lph8uTbmKNVKA57Rq9GotGcv4JqmxtIVfvXoVu0P6wNhKAXY4cd2ckuw-8JmUd77_VTetXcl60VQ1"
data = IDS & subIDs & "&" & Tokens
xhr.send data
'xhr.waitForResponse (10)
Do Until xhr.readyState = 4
DoEvents
Loop
' Debug.Print xhr.responseText 'xhr.responseText
Dim oDoc As HTMLDocument
Set oDoc = New HTMLDocument
oDoc.Body.innerHTML = xhr.responseText
'Debug.Print oDoc.Body.innerText
splits = Split(oDoc.Body.innerText, vbNewLine)
Sheet1.Cells(x, 5) = Replace(Replace(splits(10), "E-posta", ""), " ", "")
Sheet3.Range("a1:l1").Offset(Sheet3.Range("a65000").End(3).Row, 0).Cells = splits
Set oDoc = Nothing
Set xhr = Nothing
x = x + 1
If x = y Then
10
time1 = Now
time2 = Now + TimeValue("0:00:1")
Do Until time1 >= time2
DoEvents
time1 = Now()
Loop
y = y + 70
End If
Loop

.Write objHTTP.responseBody runtime error 3001

I have some problem with this vba code. This work from over the year. After last execution i get error in ".Write objHTTP.responseBody --runtime error 3001" I try figure out solution but I don't have any ideas. The code login in on page and download 4 files.
This is POST information:
Answers headers (250 B)
Connection
Keep-Alive
Content-Disposition
attachement; filename="baza.csv";
Content-Type
application/csv
Date
Tue, 17 Jul 2018 13:58:32 GMT
Keep-Alive
timeout=5, max=300
Server
Apache/2.4.25
Transfer-Encoding
chunked
Request Headers (976 B)
Accept
text/html,application/xhtml+xm…plication/xml;q=0.9,*/*;q=0.8
Accept-Encoding
gzip, deflate, br
Accept-Language
pl,en-US;q=0.7,en;q=0.3
Connection
keep-alive
Content-Length 38
Content-Type
application/x-www-form-urlencoded
Cookie _pk_id.50.777d=00d79034e23a5b6…41fc349c56e551787285709412976
DNT 1
Host listarobinsonow.pl
Referer https://listarobinsonow.pl/userpanel/base
Upgrade-Insecure-Requests 1
User-Agent Mozilla/5.0 (Windows NT 10.0; …) Gecko/20100101 Firefox/61.0
Code:
Sub SMB_DownloadAll()
Dim destfolder As String
destfolder = ActiveWorkbook.Path
' Autoryzacja
' Dim objHTTP As New WinHttp.WinHttpRequest
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "http://www.listarobinsonow.pl/auth/login"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("identity=xxxxxx&password=xxxxxxx")
objHTTP.WaitForResponse
' pobranie 4 plików
SMB_Download objHTTP, "post", destfolder
SMB_Download objHTTP, "mail", destfolder
SMB_Download objHTTP, "tele", destfolder
SMB_Download objHTTP, "smss", destfolder
ThisWorkbook.Save
End Sub
Sub SMB_Download(ByRef objHTTP, base_type As String, destfolder As String)
URL = "http://www.listarobinsonow.pl/userpanel/base"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("base_type=" + base_type + "&form_type=base_download")
objHTTP.WaitForResponse
' Dim oStream1 As New ADODB.Stream
Set oStream1 = CreateObject("ADODB.Stream")
With oStream1
.Type = 1
.Open
.Write objHTTP.responseBody - the place where i get error run time 3001
.SaveToFile destfolder + "\" + base_type + ".csv", 2
End With
End Sub

Amazon URL scraping with XMLHTTP - Amazon blocking?

So if I use my browser to browse to a list of a product's ellers, for example:
https://www.amazon.co.uk/gp/offer-listing/B076C6769Z/ref=dp_olp_new?ie=UTF8&condition=new
I see a list of sellers.
BUT if I construct the same URL with VBA utilising XMLHTTP, Amazon returns a different page (generic page not related to the product). it's as if they've sussed that I'm not a person using a browser?
Dim XMLHTTP As Object, html As Object, objResult As Object
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
url = "https://www.amazon.co.uk/gp/offer-listing/B002AVVO7K/ref=dp_olp_new?
ie=UTF8&condition=new"
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0)
Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.responseText
Debug.Print XMLHTTP.responseText

Can't parse name from a webpage using POST request

I've written a macro in vba to get a "name" from a website using POST request. To reach the target page it is necessary to send POST request twice. Firstly, a page opens up like the first image underneath. After clicking on the "search by address" button on the starting page it leads to another page where two boxes to be filled in which is shown in the image 2 below. One for street number and the other for street name. After clicking on the search button when the form is done filling then it leads to the target page with the information i'm after. I tested it using msgbox in the script to be sure i'm on the right page. I'm surely on that page and i can see the title of that page which is "HARRIS COUNTY APPRAISAL DISTRICT". However, I can't parse anything from that page. I'm after this name "LARA PEDRO A & MARIA G" from that page.
This is the macro I'm trying with:
Sub httpPost()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim rec As HTMLHtmlElement
Dim ArgStr As String, ArgStr_ano As String
ArgStr = "search=addr"
ArgStr_ano = "TaxYear=2017&stnum=15535&stname=CAMPDEN+HILL+RD"
With http
.Open "POST", "https://public.hcad.org/records/QuickSearch.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr
End With
With http
.Open "POST", "https://public.hcad.org/records/QuickRecord.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr_ano
html.body.innerHTML = .responseText
End With
MsgBox http.responseText
End Sub
Search to be made with:
Street No: 15535
Street Name: CAMPDEN HILL RD
These are the image of two pages following which target page can be reached:
"https://www.dropbox.com/s/e9on9zwqzmcboze/1Untitled.jpg?dl=0"
"https://www.dropbox.com/s/0lchpde8uq63jps/pics.jpg?dl=0"
I somehow caught the url using chrome developer tool and using that url in my below code I get the result I'm after. However, what's wrong with my "POST" request? Why can't I get the same using the above method? For your consideration, here is another bit of code to get the result using the collected url from chrome dev tool what i got by sending post request twice as i did in my above code:
Sub Web_Data()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim post As Object
With http
.Open "GET", "https://public.hcad.org/records/details.asp?crypt=%94%9A%B0%94%BFg%85%8D%83%82og%8El%87tXvXQJXJzDTpHjEyr%D4%BE%C2%AF%AE%AA%9Fpk%88%5Do%5B%B8%96%A3%C0q%5E&bld=1&tab=", False
.send
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByClassName("data")(2).getElementsByTagName("th")
i = i + 1: Cells(i, 1) = post.innerText
Next post
End Sub
The result is:
LARA PEDRO A & MARIA G
15531 CAMPDEN HILL RD
HOUSTON TX 77053-3302
Finally solved it myself. Here is the working code:
Sub httpPost()
Dim http As New WinHttp.WinHttpRequest, html As New HTMLDocument
Dim post As Object
Dim ArgStr As String, ArgStr_ano As String
ArgStr = "search=addr"
ArgStr_ano = "TaxYear=2017&stnum=15535&stname=CAMPDEN+HILL+RD"
With http
.Option(6) = True
.Open "POST", "https://public.hcad.org/records/QuickSearch.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr
End With
With http
.Option(6) = True
.Open "POST", "https://public.hcad.org/records/QuickRecord.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr_ano
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByClassName("data")(2).getElementsByTagName("th")
i = i + 1: Cells(i, 1) = post.innerText
Next post
End Sub