Question

我需要将ESPN Fantasy Football的数据导入Excel。这包括多个页面，Web查询不起作用。网址为http://games.espn.com/ffl/tools/projections?startIndex=0。当您单击下一步时，URL将变为http://games.espn.com/ffl/tools/projections?startIndex=40和80，依此类推。基本上，当您单击下一页时，startIndex会增加到40的倍数。

这是我用户到目前为止修改了@Dee提供的代码的代码，它似乎添加了一个新的工作表但没有数据。

 Private Const URL_TEMPLATE As String = 
"URL;http://games.espn.com/ffl/tools/projections?startIndex={0}"
Private Const NUMBER_OF_PAGES As Byte = 7

Sub test()
    Dim page As Byte
    Dim queryTableObject As QueryTable
    Dim url As String

    For page = 1 To NUMBER_OF_PAGES
        url = VBA.Strings.Replace(URL_TEMPLATE, "{0}", page * 40)
        Set queryTableObject = ActiveSheet.QueryTables.Add(Connection:=url, Destination:=ThisWorkbook.Worksheets.Add.[a1])
        queryTableObject.WebSelectionType = xlSpecifiedTables
        queryTableObject.WebTables = "14"
        queryTableObject.Refresh
    Next page

End Sub

最终结果应该是将每个页面中的所有列拉到一个Excel工作表中的选项卡中。有没有办法做到这一点？请协助。

谢谢， Ĵ

Answer 1

表格的Id不是14，而是playertable_0。如果您需要将所有数据粘贴到一张表中，请尝试使用以下修改后的代码。 Number of pages只是通过猜测来确定。您将不得不添加更多代码来证明，例如， Next元素出现在页面上，并在do-loop中进行，或者只是猜测页数。 HTH

Option Explicit

Private Const URL_TEMPLATE As String = _
 "URL;http://games.espn.com/ffl/tools/projections?startIndex={0}"
Private Const NUMBER_OF_PAGES As Byte = 20
Private Const TableId As String = "playertable_0"

Sub test()
    Dim page As Byte
    Dim queryTableObject As QueryTable
    Dim url As String
    Dim ws As Worksheet
    Dim target As Range
    Dim lastRow As Long

    Set ws = ThisWorkbook.Worksheets.Add
    Set target = ws.[a1]
    lastRow = 1

    For page = 0 To NUMBER_OF_PAGES
        url = VBA.Strings.Replace(URL_TEMPLATE, "{0}", page * 40)

        Set queryTableObject = ActiveSheet.QueryTables.Add( _
            Connection:=url, _
            Destination:=target)

        With queryTableObject
            .BackgroundQuery = False ' Run the query synchronously 
                                     ' to be able to compute the last row
            .WebSelectionType = xlSpecifiedTables
            .WebTables = TableId
            .Refresh
        End With

        lastRow = ws.Cells.Find( _
            what:="*", _
            SearchDirection:=xlPrevious, _
            SearchOrder:=xlByRows) _
            .Row

        Set target = ws.Cells(lastRow + 1, 1)
        target.Select
    Next page
End Sub

Answer 2

放手一搏。我希望它能解决你遇到的所有问题。

Sub Espn_Data()
    Const URL = "http://games.espn.com/ffl/tools/projections?startIndex="
    Dim http As New XMLHTTP60, html As New HTMLDocument, page As Long
    Dim htmla As Object, tRow As Object, tCel As Object, ws As Worksheet

    For page = 0 To 120 Step 40  '''input the highest number replacing 120 to get them all
        With http
            .Open "GET", URL & page, False
            .send
            html.body.innerHTML = .responseText
        End With

        With ThisWorkbook
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = page
        End With

        Set htmla = html.getElementsByClassName("playerTableTable tableBody")(0)

        For Each tRow In htmla.Rows
            For Each tCel In tRow.Cells
                c = c + 1: Cells(x + 1, c) = tCel.innerText
            Next tCel
            c = 0
            x = x + 1
        Next tRow
        c = 0
        x = 0
    Next page
End Sub

如何从ESPN将多个页面导入Excel

2 个答案: