用html代码实现做题记分,html解析cricinfo记分卡

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