Как исправить Excel VBA QueryTables не тянет данные с веб-сайта

Question

Я использовал этот код в прошлом, чтобы получить данные из ESPN для реестров в моей фэнтезийной бейсбольной лиге. Мне удалось получить списки и поместить их все в одну колонку в Excel. Тогда сделайте некоторое форматирование. Но теперь данные не могут быть извлечены. Ничего не показывает ESPN изменили свой сайт, чтобы он выглядел по-другому, поэтому я склонен думать, что это повлияло на работу этого кода.

То, что я пытался изменить в коде до сих пор: измените «.WebSelectionType» для всех трех типов (xlSpecifiedTables, xlAllTables, xlEntirepage); пробовал разные значения .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

Answer 1

Практически вся эта информация (я думаю, на самом деле намного больше) доступна в ответе json от их API. Ниже приведен пример для команд и имен. Вам нужно использовать json parser . После добавления .bas по ссылке, предоставленной в вашем проекте, добавьте ссылки, показанные ниже.

Добавьте стандартный модуль в ваш проект, открыв VBE с помощью Alt + F11 , щелкните правой кнопкой мыши в области проекта и добавьте модуль. Затем вставьте код в модуль, например. модуль 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 (информация об одном игроке):

Ниже приведен лишь небольшой пример всей информации, полученной для каждого игрока команды (слишком много, чтобы показать все это)

---

Пример вывода: