Sub GetContent()
Const Url$ = "https://vymaps.com/"
Dim Http As New XMLHTTP60, Html As New HTMLDocument
Dim HtmlDoc As New HTMLDocument, HtmlNewDoc As New HTMLDocument
Dim HtmlLastDoc As New HTMLDocument, HtmlFinalDoc As New HTMLDocument
Dim I&, N&, F&, L&, R&, secondPageLink$, thirdPageLink$, fourthPageLink$
Dim finalPageLink$, oName$, oAddress$, oCoordiname$
With Http
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Html.body.innerHTML = .responseText
End With
With Html.querySelectorAll(".four > a[href*='//vymaps.com/']")
For I = 1 To .Length - 1
secondPageLink = "https:" & Replace(.item(I).getAttribute("href"), "about:", "")
With Http
.Open "GET", secondPageLink, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
HtmlDoc.body.innerHTML = .responseText
End With
With HtmlDoc.querySelectorAll(".four > a[href*='//vymaps.com/']")
For N = 0 To .Length - 1
thirdPageLink = "https:" & Replace(.item(N).getAttribute("href"), "about:", "")
With Http
.Open "GET", thirdPageLink, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
HtmlNewDoc.body.innerHTML = .responseText
End With
With HtmlNewDoc.querySelectorAll(".four > a[href*='//vymaps.com/']")
For F = 0 To .Length - 1
fourthPageLink = "https:" & Replace(.item(F).getAttribute("href"), "about:", "")
With Http
.Open "GET", fourthPageLink, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
HtmlLastDoc.body.innerHTML = .responseText
End With
With HtmlLastDoc.querySelectorAll(".six > p > b > a[href*='//vymaps.com/']")
For L = 0 To .Length - 1
finalPageLink = "https:" & Replace(.item(L).getAttribute("href"), "about:", "")
With Http
.Open "GET", finalPageLink, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
HtmlFinalDoc.body.innerHTML = .responseText
End With
oName = HtmlFinalDoc.querySelector("h1[itemprop='name'] > a").innerText
oAddress = HtmlFinalDoc.querySelector("td[itemprop='address']").innerText
oCoordiname = HtmlFinalDoc.querySelector("td[itemprop='geo'] > a[href]").innerText
R = R + 1: ActiveSheet.Cells(R, 1) = oName
ActiveSheet.Cells(R, 2) = oAddress
ActiveSheet.Cells(R, 3) = oCoordiname
Next L
End With
Next F
Stop '---------kick it out later when you decide to execute the script for long
End With
Next N
End With
Next I
End With
End Sub