Need Help Scrapping

[ianjosephanunciacion]

Hi Guys,

I need some help here.

What should be my formula if i want to scrappe school ratings from greatschools.org???

Need to scrappe the assigned school ratings (1st three) - Look up value will be Address, City, Zip Code (1 cell each value).

Thanks in advance if ever I get an answer!

 

[Worf]

This is the first part, viewing the table:

Sub Scrape2()
Dim Browser As InternetExplorer, Document As HTMLDocument, elems, doc, i%
Set Browser = New InternetExplorer
Browser.Visible = True
'Browser.Navigate "https://www.greatschools.org/florida/orlando/schools/"
Browser.Navigate "https://www.greatschools.org/" & [a1] & "/" & [b1] & "/schools/"
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
    DoEvents
Loop
Set doc = Browser.Document
Application.Wait (Now + TimeValue("0:00:01"))
Set elems = doc.getElementsByTagName("button")
For i = 0 To elems.Length - 1
    If Len(elems(i).ClassName) = 0 Then elems(i).Click  ' table view
Next
End Sub

 

[ianjosephanunciacion]

Thanks so much! Really appreciate it!

 

[Worf]

This one should do it:

Sub Scrape2()
Dim Browser As InternetExplorer, Document As HTMLDocument, elems, doc, i%, _
schools As New Collection, ws As Worksheet, res$, c%, url$, lr%, r As Range
Set Browser = New InternetExplorer
Browser.Visible = True
'Browser.Navigate "https://www.greatschools.org/florida/orlando/schools/"
Browser.Navigate "https://www.greatschools.org/" & [a1] & "/" & [b1] & "/schools/"
Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
    DoEvents
Loop
Set doc = Browser.Document
Application.Wait (Now + TimeValue("0:00:01"))
Set elems = doc.getElementsByTagName("button")
For i = 0 To elems.Length - 1
    If Len(elems(i).ClassName) = 0 Then elems(i).Click  ' table view
Next
Browser.ExecWB 17, 0
Browser.ExecWB 12, 2
Set ws = Sheets("List1")
ws.Cells.ClearContents
ws.PasteSpecial "HTML", False, False
res = ""
lr = Split(ws.UsedRange.Address, "$")(4)
ws.Activate
Set r = Cells.Find("Showing 1 to 25", [a1], xlValues, xlPart)   ' where data begins
c = 0
i = r.Row + 1
On Error Resume Next
Do While c < 4 And i < lr And schools.Count < 4
    url = GetURL(Cells(i, r.Column))
    If url <> "no" And Not url Like "*success*" And Not url Like "*campaign*" _
    And Not url Like "*How-we-fund*" Then
        schools.Add url, url                ' avoid duplicates
        c = c + 1
    End If
    i = i + 1
Loop
On Error GoTo 0
For i = 1 To schools.Count
    res = res & schools(i) & vbLf
Next
MsgBox res, 64, "Top Three"
End Sub

Function GetURL$(c As Range)
If (c.Range("A1").Hyperlinks.Count <> 1) Then
    GetURL = "no"
Else
    GetURL = c.Range("a1").Hyperlinks(1).Address
End If
End Function
'***************