I've written a script in vba to get only the links of different properties under the title Single Family Homes from the right sided area of a webpage. When I run my script, I get nothing, no error either. The content I wish to grab are static and available within page source, so XMLHttpRequestshould do the trick.
Although it seems the selectors I've defined within my script is errorless, I can't still fetch the links of different properties.
Webpage address
I've written:
Sub GetLinks()
Const link$ = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim oHttp As New XMLHTTP60, Html As New HTMLDocument
Dim I&
With oHttp
.Open "GET", link, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Html.body.innerHTML = .responseText
With Html.querySelectorAll("article > a.list-card-info")
For I = 0 To .Length - 1
Sheet1.Range("A1").Offset(I, 0) = .item(I).getAttribute("href")
Next I
End With
End With
End Sub
Expected links are like:
https://www.zillow.com/homedetails/3446-NW-15th-St-Miami-FL-33125/43822210_zpid/
https://www.zillow.com/homedetails/1877-NW-22nd-Ave-Miami-FL-33125/43823838_zpid/
https://www.zillow.com/homedetails/1605-NW-8th-Ter-Miami-FL-33125/43825765_zpid/
How can I get all the links of different properties from it's landing page from the link above?
Use the class of the child alone. Note there are a number of other things I would like to change about the code but know you like to keep your structure/style.
Sub GetLinks()
Const link$ = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim oHttp As New XMLHTTP60, Html As New HTMLDocument
Dim I&
With oHttp
.Open "GET", link, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Html.body.innerHTML = .responseText
With Html.querySelectorAll(".list-card-info")
For I = 0 To .Length - 1
Sheet1.Range("A1").Offset(I, 0) = .item(I).getAttribute("href")
Next I
End With
End With
End Sub
Some of the changes I might make:
Private Sub GetLinks()
Const LINK As String = "https://www.zillow.com/homes/for_sale/33125/house_type/12_zm/0_mmm/"
Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
Dim i As Long, links As Object
Set http = New MSXML2.XMLHTTP60: Set html = New MSHTML.HTMLDocument
With http
.Open "GET", LINK, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
html.body.innerHTML = .responseText
End With
Set links = html.querySelectorAll(".list-card-info")
With ThisWorkbook.Worksheets("Sheet1")
For i = 0 To links.Length - 1
.Cells(i + 1, 1) = links.item(i).href
Next i
End With
End Sub
Related
I am trying to get Addresses Data from URL but facing some error. I am just beginner in VBA, i did not Understand where is problem in my code. wish somebody can help me to get right solution.
here I attached Image and also my VBA code
here is my Code
Public Sub IE_GetLink()
Dim sResponse As String, HTML As HTMLDocument
Dim url As String
Dim Re As Object
Set HTML = New HTMLDocument
Set Re = CreateObject("MSXML2.XMLHTTP")
'On Error Resume Next
url = "http://markexpress.co.in/network1.aspx?Center=360370&Tmp=1656224682265"
With Re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
Dim Title As Object
With HTML
.body.innerHTML = sResponse
Title = .querySelectorAll("#colspan")(0).innerText
End With
MsgBox Title
End Sub
Please help me ...
Several things.
What is wrong with your code:
Title should be a string as you are attempting to assign the return of .innerText to it. You have declared it as an object which would require SET keyword (and the removal of the .innerText accessor).
Colspan is an attribute not an id so your css selector list is incorrect.
Furthermore, looking at what the page actually does, there is a request for an additional document which actually has the info you need. You need to take the centre ID you already have and change the URI you make a request to.
Then, you want only the first td in the target table. Change your CSS selector list to target that.
Public Sub GetInfo()
Dim HTML As MSHTML.HTMLDocument
Dim re As Object
Set HTML = New MSHTML.HTMLDocument
Set re = CreateObject("MSXML2.XMLHTTP")
Dim url As String
Dim response As String
url = "http://crm.markerp.in/NetworkDetail.aspx?Center=360370&Tmp="
With re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
response = .responseText
End With
Dim info As String
With HTML
.body.innerHTML = response
info = .querySelector("#tblDisp td").innerText
End With
MsgBox info
End Sub
I am getting a problem to scroll document in a proper position, also getting a problem to capture a proper detail in excel here is my Code please Sir suggest me where I am getting wrong
here i try with following code still getting some error
Public Sub GData()
'On Error Resume Next
Dim html As HTMLDocument
Dim Re, Cr, cipherDict As Object
Dim sResponse, cipherKey, Str, SG As String
Dim myArr, RsltArr(14) As Variant
Set Re = CreateObject("vbscript.regexp")
Set Cr = CreateObject("MSXML2.XMLHTTP")
Set cipherDict = CreateObject("Scripting.Dictionary")
Set html = New HTMLDocument
URL = "https://www.google.com/maps/place/Silky+Beauty+Salon/#22.2932632,70.7723656,17z/data=!3m1!4b1!4m5!3m4!1s0x3959ca1278f4820b:0x44e998d30e14a58c!8m2!3d22.2932632!4d70.7745543"
With Cr
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
s = .responseText
End With
With html
.body.innerHTML = sResponse
title = .querySelector("section-hero-header-title-title").innerText
phone = .querySelector("[data-item-id^=phone] [jsan*=text]").innerText
webSite = .querySelector("[aria-label^=Website] [jsan*=text]").innerText
End With
datarw = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(datarw, 1).Value = title
ActiveSheet.Cells(datarw, 5).Value = phone
ActiveSheet.Cells(datarw, 7).Value = webSite
ActiveSheet.Cells(datarw, 1).Select
ActiveSheet.Rows(datarw).WrapText = False
End Sub
Looks like you can use combinations of different combinators (^ starts with and * contains) to search for substrings in attributes on the page to get your target nodes. Using descendant combinators to specify the relationship between attributes being used for anchoring.
Test if matched node Is Not Nothing before attempting to access either an attribute value or .innerText
Dim phone as Object, webSite As Object, title As Object
Set title = ie.document.querySelector(".section-hero-header-title-title")
Set phone = ie.document.querySelector("[data-item-id^=phone] [jsan*=text]")
Set website = ie.document.querySelector("[aria-label^=Website] [jsan*=text]")
If Not phone Is Nothing Then
'clean phone.innerText as appropriate
End If
If Not website Is Nothing Then
'clean website.innerText as appropriate
End If
To get the appropriate protocol for the website address, if missing, you can use the cleaned website address you have in a regex to pull the protocol from earlier in the html where it sits in a script tag.
Read about
css selectors: https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_Selectors
querySelector: querySelector and querySelectorAll vs getElementsByClassName and getElementById in JavaScript
I'm trying to figure out how I can use .querySelector() on .querySelectorAll().
For example, I get expected results when I try like this:
Sub GetContent()
Const URL$ = "https://stackoverflow.com/questions/tagged/web-scraping?tab=Newest"
Dim HTMLDoc As New HTMLDocument
Dim HTML As New HTMLDocument, R&, I&
With New XMLHTTP60
.Open "Get", URL, False
.send
HTMLDoc.body.innerHTML = .responseText
End With
With HTMLDoc.querySelectorAll(".summary")
For I = 0 To .Length - 1
HTML.body.innerHTML = .Item(I).outerHTML
R = R + 1: Cells(R, 1).Value = HTML.querySelector(".question-hyperlink").innerText
Next I
End With
End Sub
The script doesn't work anymore when I pick another site in order to grab the values under Rank column available in the table even when I use the same logic:
Sub GetContent()
Const URL$ = "https://www.worldathletics.org/records/toplists/sprints/100-metres/outdoor/men/senior/2020?page=1"
Dim HTMLDoc As New HTMLDocument
Dim HTML As New HTMLDocument, R&, I&
With New XMLHTTP60
.Open "Get", URL, False
.send
HTMLDoc.body.innerHTML = .responseText
End With
With HTMLDoc.querySelectorAll("#toplists tbody tr")
For I = 0 To .Length - 1
HTML.body.innerHTML = .Item(I).outerHTML
R = R + 1: Cells(R, 1).Value = HTML.querySelector("td").innerText
Next I
End With
End Sub
This is the line Cells(R, 1).Value = HTML.querySelector().innerText In both the script I'm talking about. I'm using the same within this container .querySelectorAll().
If I use .querySelector() on .getElementsByTagName(), I found it working. I also found success using TagName on TagName or ClassName on ClassName e.t.c. So, I can grab the content in few different ways.
How can I use .querySelector() on .querySelectorAll() in the second script in order for it to work?
Wrap it in table tags so the html parser knows what to do with it.
HTML.body.innerHTML = "<table>" & .Item(I).outerHTML & "</table>"
Doing so preserves the structure of the opening td tag which is otherwise stripped of the "<".
I have got a responseText from an XMLHTTP request:
Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
XMLHttp.Open "GET", urlPiece, False
XMLHttp.send
that I store in an HTML file created in memory:
Set htmlResponse = CreateObject("htmlfile")
htmlResponse.body.innerHTML = XMLHttp.responseText
If I look at the object htmlResponse on the debugger, I see the structure of a normal HTML file. However, when I try to get the document, I don't succeed:
Set doc = htmlResponse.document '<-- Invalid method or property
What am I doing wrong? Below my full code in case you want to test on real sample:
Sub getPrice()
Dim urlPiece As String: urlPiece = "https://fr.finance.yahoo.com/q?s="
Dim htmlResponse As Object
Dim XMLHttp As Object
Set htmlResponse = CreateObject("htmlfile")
ccyPair = "XAUUSD"
urlPiece = urlPiece & ccyPair & "=X"
Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
XMLHttp.Open "GET", urlPiece, False
XMLHttp.send
htmlResponse.body.innerHTML = XMLHttp.responseText
Set doc = htmlResponse.document '<-- error here
End Sub
I have found the mistake myself.
Differently than JavaScript, the document is defined in the body of the HTMLfile and is not itself an attribute of the object.
Hence:
Set doc = htmlResponse.document
should rather be
Set doc = htmlResponse.body.document
I need to fetch some values from www.Eppraisa.com using Excel Macro.
But I don't know what should be the value of PropID. That's why the macro works for URL1 but not for URL2 because I think URL2 has a wrong propID
Const URL1 As String = "http://www.eppraisal.com/home-values/property_lookup_eppraisal?a=1122%20E%20Loyola%20Dr&z=85282&propid=42382460"
Const URL2 As String = "http://www.eppraisal.com/home-values/property_lookup_eppraisal?a=19732%20E%20Reins%20Rd&z=85142&propid=31402642"
Sub xmlHttp()
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
' This works
xmlHttp.Open "GET", URL1, False
' But doesn't work for below url :(
'xmlHttp.Open "GET", URL2, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
Dim ieDom As New HTMLDocument
Dim html As Object
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText
Debug.Print html.body.innerHTML
ieDom.body.innerHTML = xmlHttp.responseText
For Each ieInp In ieDom.getElementsByTagName("p")
If ieInp.className = "ColorAccent6 FontBold FontSizeM Margin0 Padding0" Then
strEppraisalValue = ieInp.innerText
ElseIf ieInp.className = "FontSizeA Margin0 DisplayNone HighLow" Then
strEppraisalHighLow = ieInp.innerText
End If
Next End Sub
With Mozilla Firefox & Firebug you can identify the request and response.
Below step applies to any search you make.
1 Copy the below URL to Firefox Browser.
http://www.eppraisal.com/home-values/property/1122-e-loyola-dr-tempe-az-85282-42382460/
2 Open Up FireBug and look for below request. Goto Net Tab > XHR as in below image.
3 Expand the node and goto Params tab. It shows all the input parameters which needs to go with the GET request.
.
4 Finally we can see the response from server in the Response Tab.