I've created a parser which is able to parse the full content of houzz.com. After going to the given address, it parses the sub-category links from the left sided bar. Each sub-category links spreads across several pages with pagination. Then it goes to the main page of each sub category links and parses the content over there. I tried to do the whole thing with my level best.
Sub HouzzFull()
Const url = "https://www.houzz.com/professionals/"
Dim http As New ServerXMLHTTP60
Dim html As New HTMLDocument, htm As New HTMLDocument, hmm As New HTMLDocument
Dim str As String, link As String, main As String
Dim topics As Object, topic As Object
Dim links As Object, post As Object, gist As HTMLHtmlElement
With http
.Open "GET", url, False
.send
html.body.innerHTML = .responseText
End With
Set topics = html.getElementsByClassName("sidebar-item-label")
For i = 1 To topics.Length - 1
str = topics(i).href
With http
.Open "GET", str, False
.send
htm.body.innerHTML = .responseText
End With
Set links = htm.getElementsByClassName("pageNumber")
For y = 0 To links.Length - IIf(links.Length > 0, 1, 0)
If y > 0 Then
link = links(y).href
With http
.Open "GET", link, False
.send
htm.body.innerHTML = .responseText
End With
End If
Set topic = htm.getElementsByClassName("pro-title")
For Each post In topic
main = post.href
With http
.Open "GET", main, False
.send
hmm.body.innerHTML = .responseText
End With
For Each gist In hmm.getElementsByClassName("container profile-carded")
x = x + 1
With gist.getElementsByClassName("profile-full-name")
If .Length Then Cells(x, 1) = .Item(0).innerText
End With
With gist.getElementsByClassName("info-list-text")
If .Length > 1 Then Cells(x, 2) = Replace(.Item(1).innerText, "Contact:", "")
End With
With gist.getElementsByClassName("info-list-text")
If .Length > 2 Then Cells(x, 3) = Replace(.Item(2).innerText, "Location:", "")
End With
With gist.getElementsByClassName("click-to-call-link text-gray-light trackMe")
If .Length Then Cells(x, 4) = .Item(0).phone
End With
With gist.getElementsByClassName("proWebsiteLink")
If .Length Then Cells(x, 5) = .Item(0).href
End With
Next gist
Next post
Next y
Next i
End Sub