慕雪6442864

对于其他对此感兴趣的人，我最终根据Siddhart Rout的早期答案使用了下面的代码XMLHttp 比自动化快得多 IE代码为每个要下载的系列生成一个CSV文件(保存在X变量中)代码将每个匹配转储到常规的29行范围(无论有多少玩家参与)，以便稍后进行简单的分析    Public Sub PopulateDataSheets_XML()

Dim URL As String

Dim ws As Worksheet

Dim lngRow As Long

Dim lngRecords As Long

Dim lngWrite As Long

Dim lngSpare As Long

Dim lngInnings As Long

Dim lngRow1 As Long

Dim X(1 To 15, 1 To 4) As String

Dim objFSO As Object

Dim objTF As Object

Dim xmlHttp As Object

Dim htmldoc As HTMLDocument

Dim htmlbody As htmlbody    Dim tbl As HTMLTable

Dim tr As HTMLTableRow

Dim strInnings As String

s = Timer()

Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP")

Set objFSO = CreateObject("scripting.filesystemobject")

X(1, 1) = "http://www.espncricinfo.com/indian-premier-league-2011/engine/match/"

X(1, 2) = 501198

X(1, 3) = 501271

X(1, 4) = "indian-premier-league-2011"

X(2, 1) = "http://www.espncricinfo.com/big-bash-league-2011/engine/match/"

X(2, 2) = 524915

X(2, 3) = 524945

X(2, 4) = "big-bash-league-2011"

X(3, 1) = "http://www.espncricinfo.com/ausdomestic-2010/engine/match/"

X(3, 2) = 461028

X(3, 3) = 461047

X(3, 4) = "big-bash-league-2010"

Set htmldoc = New HTMLDocument

Set htmlbody = htmldoc.body    For lngRow = 1 To UBound(X, 1)

If Len(X(lngRow, 1)) = 0 Then Exit For

Set objTF = objFSO.createtextfile("c:\temp\" & X(lngRow, 4) & ".csv")

For lngRecords = X(lngRow, 2) To X(lngRow, 3)

URL = X(lngRow, 1) & lngRecords & ".html"

xmlHttp.Open "GET", URL

xmlHttp.send

Do While xmlHttp.Status <> 200

DoEvents

Loop

htmlbody.innerHTML = xmlHttp.responseText

objTF.writeline X(lngRow, 1) & lngRecords & ".html"

For lngInnings = 1 To 2

strInnings = "Innings " & lngInnings

objTF.writeline strInnings

Set tbl = Nothing

On Error Resume Next

Set tbl = htmlbody.Document.getElementById("inningsBat" & lngInnings)

On Error GoTo 0

If Not tbl Is Nothing Then

lngWrite = 0

For lngRow1 = 0 To tbl.Rows.Length - 1

Set tr = tbl.Rows(lngRow1)

If Trim(tr.innerText) <> vbNewLine Then

If tr.Cells.Length > 2 Then

If tr.Cells(1).innerText <> "Extras" Then

If Len(tr.Cells(1).innerText) > 0 Then

objTF.writeline strInnings & "-" & lngWrite & "," & Trim(tr.Cells(1).innerText) & "," & Trim(tr.Cells(3).innerText)

lngWrite = lngWrite + 1

End If

Else

objTF.writeline strInnings & "-" & lngWrite & "," & Trim(tr.Cells(1).innerText) & "," & Trim(tr.Cells(3).innerText)

lngWrite = lngWrite + 1

Exit For

End If

End If

End If

Next

For lngSpare = 12 To lngWrite Step -1

objTF.writeline strInnings & "-" & lngWrite + (12 - lngSpare)

Next

Else

For lngSpare = 1 To 13

objTF.writeline strInnings & "-" & lngWrite + (12 - lngSpare)

Next

End If

Next

Next

Next

'Call ConsolidateSheets

End Sub