Sub Test()
Dim html As New HTMLDocument
Dim posts As Object
Dim post As Object
Dim v As Object
Dim w As Object
Dim x As Object
Dim p As Long
Dim r As Long
ReDim a(1 To 100000, 1 To 4)
Application.ScreenUpdating = False
For p = 1 To 2
html.body.innerHTML = GetHTMLSource("https://maps.me/catalog/education/amenity-school/?page=" & p)
Set posts = html.getElementsByClassName("item__title")
For Each post In posts
r = r + 1
a(r, 1) = post.innerText
Set v = post.NextSibling.getElementsByTagName("p")(0)
If Not v Is Nothing Then a(r, 2) = v.innerText
Set w = post.NextSibling.getElementsByTagName("p")(1)
If Not w Is Nothing Then If Mid(w.innerText, 1, 5) = "Phone" Then a(r, 3) = Replace(w.innerText, "Phone: ", "'")
Set x = post.NextSibling.getElementsByTagName("p")(2)
If Not x Is Nothing Then If Mid(x.innerText, 1, 7) = "Website" Then a(r, 4) = Replace(x.innerText, "Website: ", "")
Next post
Set html = Nothing
Next p
Columns("A:D").ClearContents
Range("A1").Resize(1, 4).Font.Bold = True
Range("A1").Resize(1, 4).Value = Array("School Name", "Address", "Phone", "Website")
Range("A2").Resize(r, UBound(a, 2)).Value = a
Application.ScreenUpdating = True
End Sub
Function GetHTMLSource(strURL As String) As String
Dim XMLHTTP As Object
Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
With XMLHTTP
.setTimeouts 4000, 4000, 4000, 4000
.Open "GET", strURL, False
.send
If .Status = 200 Then GetHTMLSource = XMLHTTP.responseText Else GetHTMLSource = ""
End With
End Function