如何修复Excel VBA查询表不从网站提取数据的问题

我过去曾使用此代码从ESPN中提取我幻想中的棒球联盟名单的数据。我能够得到名册，并将它们全部放在Excel的一列中。然后做一些格式化。但现在，数据无法提取。什么也看不出来。ESPN确实改变了他们的网站，使其看起来与众不同，所以我倾向于认为这影响了该代码的工作方式

到目前为止，我在代码中尝试更改的内容是：更改所有三种类型（xlSpecifiedTables、xlAllTables、xlntirepage）的“.WebSelectionType”；尝试了不同的.WebTables值

-这个“.QueryTable”命令在这个url上仍然有效吗？ -我是否需要使用不同的命令/代码从该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

几乎所有这些信息（我认为实际上更多）都可以从他们的API的json响应中获得。下面是团队和名称的示例。你需要使用一种新的方法。从提供给项目的链接中添加

.bas

后，添加如下所示的引用

通过使用Alt+F11打开VBE，在项目区域中单击鼠标右键并添加模块，将标准模块添加到项目中。然后将代码粘贴到模块中，例如模块1

在VBA Json结构中，

[]

表示通过索引访问的集合或每个集合的集合。

{}

是通过键访问的字典，其他所有内容都是字符串文本

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

---

json示例（1个玩家信息）：

以下只是为每个团队成员检索到的所有信息的一个小样本（太多，无法全部显示）

---

输出示例：

---

你能分享这个URL吗？@Zac-我添加了这个URL。我想你需要浏览器自动化。您需要从页面获得的最低信息是什么？@QHarr-我至少需要玩家姓名（即“玩家”列）。在slot/player/acq列的正上方有团队名称也很有帮助。哦。。。团队名称是否像Draft Night Bday Buzz等？我收到一个错误：运行时错误“0”、KeyNotFoundError、字典键未找到：completeDate。当我按下“Debug”时，它进入json解析器模块的私有函数部分中的“json_ParseObject.item（json_Key）=json_ParseValue（json_字符串，json_索引）”。当我在这里调试时，我得到以下消息：运行时错误'10001'：错误解析JSON:2882487218，“Drawed”：应为'STRING'，'NUMBER'，null，true，false，'{'，or'['。你知道为什么会发生这种情况吗？出于某种原因，我没有看到你的消息通知。它对我来说仍然运行良好。你是否按照我的回答中所示的方式运行代码？我想知道你是否更改了代码并使用了无效的访问器syntaxI使其与Selenium类型库一起工作。我关闭了它，然后关闭了我的现在代码运行得很好。不确定为什么会这样，但它正在运行！