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
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