Sub QueryWeb()
Dim i As Integer
Dim firstRow As Integer
Dim lastRow As Integer
Dim nextRow As Integer
Dim URLstart As String
Dim URLend As String
Dim shStats As Worksheet
Dim shQuery As Worksheet
Dim rgQuery As Range
Dim found As Range
Dim TimeOutWebQuery
Dim TimeOutTime
Dim objIE As Object
Application.ScreenUpdating = False
URLstart = "http://stats.espncricinfo.com/ci/engine/stats/index.html?class=2;filter=advanced;orderby=start;page="
URLend = ";size=200;spanmax1=12+Jul+2012;spanmin1=13+Jul+2009;spanval1=span;template=results;type=batting;view=innings;wrappertype=print"
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Stats").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Stats"
Set shStats = Sheets("Stats")
For i = 1 To 47
Sheets.Add after:=Sheets(Sheets.Count)
Set shQuery = ActiveSheet
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = False
.Navigate CStr(URLstart & i & URLend)
End With
TimeOutWebQuery = 10
TimeOutTime = DateAdd("s", TimeOutWebQuery, Now)
Do Until objIE.ReadyState = 4
DoEvents
If Now > TimeOutTime Then
objIE.stop
GoTo ErrorTimeOut
End If
Loop
objIE.ExecWB 17, 2
objIE.ExecWB 12, 2
shQuery.Range("A1").Select
shQuery.PasteSpecial NoHTMLFormatting:=True
objIE.Quit
Set objIE = Nothing
Set found = shQuery.Columns(1).Find("Player", , , xlWhole)
If Not found Is Nothing Then
firstRow = found.Row
If i > 1 Then firstRow = firstRow + 1
Else
GoTo FormatError
End If
Set found = shQuery.Columns(1).Find("Page ", found, , xlPart)
If Not found Is Nothing Then
lastRow = found.Row - 1
Else
GoTo FormatError
End If
Set rgQuery = shQuery.Rows(firstRow & ":" & lastRow)
nextRow = shStats.Cells(Rows.Count, "A").End(xlUp).Row
If nextRow > 1 Then nextRow = nextRow + 1
rgQuery.Copy shStats.Cells(nextRow, 1)
Application.DisplayAlerts = False
shQuery.Delete
Application.DisplayAlerts = True
Next i
shStats.Columns.AutoFit
MsgBox "Query complete"
Exit Sub
FormatError:
MsgBox "Format Error"
Exit Sub
ErrorTimeOut:
objIE.Quit
Set objIE = Nothing
MsgBox "WebSite Error"
End Sub
