I have created a scraper for yell.com in vba. The scraper is efficient enough to pull data from that site, whatever the search parameter is. If any link from that site is given to my parser, it is able to scrape the whole records irrespective of how many pages it has spread across. There is no "a" tag for the first page in pagination option for this reason it was previously scraping all the records except for the first page. However, I've fixed that issue and now it is working flawlessly pulling all the records available there. I tried to make it accurate yet there are always rooms for improvement.
Sub Yell_parser()
Const mlink = "https://www.yell.com"
Dim http As New XMLHTTP60
Dim html As New HTMLDocument, html2 As New HTMLDocument
Dim page As Object, newlink As String
Dim I As Long, x As Long
With http
.Open "GET", "https://www.yell.com/ucs/UcsSearchAction.do?keywords=coffee&location=United+Kingdom&scrambleSeed=1370600159", 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"
.send
html.body.innerHTML = .responseText
End With
Set page = html.getElementsByClassName("row pagination")(0).getElementsByTagName("a")
' First page first, selected already, 'row pagination' doesn't have 'a' for it
GetPageData x, html
For I = 0 To page.Length - 2
newlink = mlink & Replace(page(I).href, "about:", "")
With http
.Open "GET", newlink, 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"
.send
html2.body.innerHTML = .responseText
End With
' Next pages start from here
GetPageData x, html2
Next I
End Sub
Sub GetPageData(ByRef x, ByRef html As HTMLDocument)
Dim post As HTMLHtmlElement
For Each post In html.getElementsByClassName("js-LocalBusiness")
x = x + 1
With post.getElementsByClassName("row businessCapsule--title")(0).getElementsByTagName("a")
If .Length Then Cells(x + 1, 1) = .item(0).innerText
End With
With post.getElementsByClassName("col-sm-10 col-md-11 col-lg-12 businessCapsule--address")(0).getElementsByTagName("span")
If .Length > 1 Then Cells(x + 1, 2) = .item(1).innerText
End With
With post.getElementsByClassName("col-sm-10 col-md-11 col-lg-12 businessCapsule--address")(0).getElementsByTagName("span")
If .Length > 2 Then Cells(x + 1, 3) = .item(2).innerText
End With
With post.getElementsByClassName("col-sm-10 col-md-11 col-lg-12 businessCapsule--address")(0).getElementsByTagName("span")
If .Length > 3 Then Cells(x + 1, 4) = .item(3).innerText
End With
With post.getElementsByClassName("businessCapsule--tel")
If .Length > 1 Then Cells(x + 1, 5) = .item(1).innerText
End With
Next post
End Sub