如何修复Excel VBA QueryTables不从网站提取数据

Question

I have used this code in the past to pull data from ESPN for the rosters in my fantasy baseball league. I was able to get the rosters and put them all in one column in Excel. Then do some formatting. But now, data cannot be pulled. Nothing shows. ESPN did change their site to look different so I am inclined to think that effected how this code can work.

What I have tried changing in the code so far: change the ".WebSelectionType" for all three types (xlSpecifiedTables, xlAllTables, xlEntirepage); tried different .WebTables values.

-Will this ".QueryTable" command still work on this url? -Will I have to use a different command/code to scrape the table from this url?

Sheet11.Range("h:p").ClearContents  'clear old data
url = "URL;http://fantasy.espn.com/baseball/league/rosters?leagueId=101823"

With Sheet11.QueryTables.Add(Connection:= _
    url, Destination:=Range("$h$1"))
    .Name = "MyESPNRoster"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebTables = "3,4,5,6,7,8,9,10,11,12,13,14"    'the table number to get the right table of data. there should be 12 rosters
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = True
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

Answer 1

Pretty much all that info (I think a lot more actually) is available in a json response from their API. Below is an example for the teams and names. You need to use a json parser . After adding the .bas from the link supplied to your project, add the references shown below.

Add a standard module to your project by opening the VBE with Alt + F11 , right click in project area and add module. Then paste code into module eg module 1.

In VBA Json structure the [] indicate collections accessed by index or For Each over. The {} are dictionaries accessed by key, everything else are string literals.

Option Explicit
'  VBE > Tools > References > Microsoft Scripting Runtime
Public Sub GetPlayers()
    Dim json As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Cells.ClearContents

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://fantasy.espn.com/apis/v3/games/flb/seasons/2019/segments/0/leagues/101823?view=mSettings&view=mRoster&view=mTeam&view=modular&view=mNav", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With

    Dim item As Object, nextItem As Object, r As Long, c As Long
    c = 0
    For Each item In json("teams")
        r = 1: c = c + 1
        ws.Cells(r, c) = item("location") & " " & item("nickname")
        For Each nextItem In item("roster")("entries")
            r = r + 1
            ws.Cells(r, c) = nextItem("playerPoolEntry")("player")("fullName")
        Next
    Next
End Sub

---

Sample of json (1 player info):

The following is only a small sample of all the info retrieved for each team player (too much to show it all)

---

Sample of output: