Macro to input sport schedule from website no longer working

Amnesiac

Board Regular
Joined
Apr 16, 2009
Messages
144
Hello. I have a macro that is supposed to gather all the college football team schedules from ESPN.com into a spreadsheet. I've used this the past three years but now the macro is not working and I'm unsure why. I'm getting a "Run-time error '91': Object variable or With block variable not set" error message. Any ideas?

Public Sub GetAndSaveTeamData()
SpeedOn

Dim teamsInfo As Collection
Set teamsInfo = GetTeamInfo

For i = 1 To teamsInfo.Count
Dim team As TeamInfo
Set team = teamsInfo.item(i)

If team.Division = "FBS (Division I-A Teams)" Then
GetTeamSchedule team, Const_Season
End If
Next i

WriteTeamsInfoToSheet teamsInfo

SpeedOff
End Sub
Private Function GetTeamsWebData() As String
Dim objHTTP As MSXML2.ServerXMLHTTP
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
url = "http://www.espn.com/college-football/teams"

objHTTP.Open "GET", url, False
objHTTP.send

GetTeamsWebData = objHTTP.responseText
End Function
Private Function GetTeamScheduleWebData(id As Integer, Season As Integer) As String
Dim objHTTP As MSXML2.ServerXMLHTTP
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

Query = "?id=" & id & "&year=" & Season
url = "http://www.espn.com/college-football/team/schedule" & Query

objHTTP.Open "GET", url, False
objHTTP.send

GetTeamScheduleWebData = objHTTP.responseText
End Function
Private Function GetTeamInfo() As Collection
Dim doc As MSHTML.HTMLDocument, divs As MSHTML.IHTMLElementCollection, _
div As MSHTML.IHTMLElement, innerDivs As MSHTML.IHTMLElementCollection

Dim dataset As New Collection

Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = GetTeamsWebData


Set divs = doc.getElementsByClassName("span-2")

For k = 0 To 1
Set div = divs.item(k)
Set innerDivs = div.Children <---code stops here

Dim divName As String
divName = innerDivs.item(0).innerText

For i = 1 To innerDivs.Length - 1
Dim Division As MSHTML.IHTMLElement, catName As String, _
teams As MSHTML.IHTMLElementCollection

Set Division = innerDivs.item(i)

catName = Division.Children.item(0).innerText
Set teams = Division.Children.item(1).Children.item(0).Children

For j = 0 To teams.Length - 1
Dim teamDiv As MSHTML.IHTMLElement, title As MSHTML.IHTMLElement, team As TeamInfo

Set team = New TeamInfo
Set teamDiv = teams.item(j)
Set title = teamDiv.Children.item(0).Children.item(0)


team.Name = title.innerText
team.url = title.getAttribute("href")

team.GetIdFromUrl

team.Category = catName
team.Division = divName

dataset.Add team
Next j

'If i > 2 Then Exit For
Next i
Next k

Set GetTeamInfo = dataset
End Function
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,214,864
Messages
6,121,984
Members
449,058
Latest member
oculus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top