PDA

View Full Version : Web scrapping vba



Doughtie38
12-10-2020, 02:49 AM
I'm trying to loop it to copy and paste the table and click next till there no more next the next button is a hyperlink with a "A" tagname


Sub GetData()

'define variables

Dim i As SHDocVw.InternetExplorer

Set i = New InternetExplorer

i.Visible = True

Dim IE As Object, obj As Object

Dim r As Long, c As Long, t As Long

Dim elemCollection As Object

Dim eRow As Long

Dim HTMLDoc As MSHTML.HTMLDocument

Dim HTMLInput As MSHTML.IHTMLElement

Dim HTMLAs As MSHTML.IHTMLElementCollection

Dim HTMLA As MSHTML.IHTMLElement











url_name = Sheet2.Range("e4")

If url_name = "" Then Exit Sub

i.Visible = True

i.navigate (url_name)



Do While i.readyState <> READYSTATE_COMPLETE

Loop



'we ensure that the web page is downloaded completely



ThisWorkbook.Sheets("Sheet1").Range("a2:ai1000").ClearContents

Set elemCollection = i.document.getElementsByTagName("TABLE")

For t = 0 To (elemCollection.Length - 1)

For r = 0 To (elemCollection(t).Rows.Length - 1)

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)



ThisWorkbook.Worksheets(1).Cells(eRow, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText

Next c

Next r

Next t



Range("a1:ai1000").Columns.AutoFit

'Clean up Memory

Set IE = Nothing

Set HTMLDoc = i.document



Set HTMLAs = HTMLDoc.getElementsByTagName("a")



For Each HTMLA In HTMLAs

'Debug.Print HTMLA.getAttribute("classname"), HTMLA.getAttribute("href")



If HTMLA.getAttribute("classname") = "button2 next" And HTMLA.getAttribute("href") = "Football | Player Game Finder | Stathead.com ('https://stathead.com/football/pgl_finder.cgi?request=1&game_num_max=99&week_num_max=99&order_by=all_td&match=game&season_start=1&year_max=2020&qb_gwd=0&qb_comeback=0&season_end=-1&game_type=R&age_max=99&year_min=2020&offset=100')" Then

HTMLA.Click

Exit For



End If

Next



End Sub