Ваш код:
Возможно, вы объединили отдельные биты кода, но у вас непоследовательное использование переменных.sDD Я думаю, должно быть elements, HTML должно быть Doc.Связанные объявления типов переменных для элемента и элементов должны быть следующими:
Dim element As IHTMLSpanElement
Dim elements As IHTMLElementCollection
Если элементы представляют собой коллекцию с одинаковым именем класса, тогда вам не нужно:
If element.className = "name-col__firstName"
40 соответствующих элементов для этого класса на странице, некоторые из которых повторяют ту же информацию, которую вы не ограничивали отдельной таблицей.
Вы пытаетесь проиндексировать коллекцию тегов span, используя тот же индекс, что и в коллекции имен классов, но на самом деле коллекция span имеет длину 1354 элемента, и индексы на странице не соответствуют.
Вы хотите настроить таргетинг только на интересующую таблицу и элементы в ней.Я покажу вам, как позже.
У вас также есть опечатка в этой строке:
erow = Sheet1.Cells(Rows.count, 1).edn(xlUp).Offset(1, 0).Row
Это должно быть End(xlUp).
Просто имена:
Если вы используете только информацию об имени, я бы использовал наследующий CSS-комбинатор , чтобы нацелить таблицу по идентификатору родительского элемента div, а затем фактические имена по значению ихатрибут класса.Это быстрый метод с небольшой дальнейшей оптимизацией кода путем отключения обновления экрана.
Все имена находятся в таблице с идентификатором skater-table.Селектор CSS для этого #skater-table.# обозначает идентификатор.Сами имена в этом элементе id родительской таблицы имеют атрибут class, который содержит строковое значение text.Это записывается как селектор атрибута CSS = значение [class*=text].Символ * означает, что значение имени класса содержит значение text.
. Пример соответствующих элементов можно посмотреть здесь:
VBA: Полный список имен.
Option Explicit
Public Sub GetHawksNamesInfo()
Dim IE As InternetExplorer, playerList As Object, player As Long
Application.ScreenUpdating = False
Set IE = New InternetExplorer
With IE
.Visible = False
.navigate "https://www.nhl.com/blackhawks/stats"
While .Busy Or .readyState < 4: DoEvents: Wend
Set playerList = IE.document.querySelectorAll("#skater-table [class*=text]")
With ThisWorkbook.Worksheets("Sheet1")
For player = 0 To playerList.Length - 1
.Cells(player + 1, 1) = playerList.item(player).innerText
Next
End With
.Quit
End With
Application.ScreenUpdating = True
End Sub
Весь стол:
Вы можете взять всю таблицу вместе с фотографиями игроков, скопировав вбуфер обмена, а затем вставьте его на лист, используя:
Option Explicit
Public Sub GetInfo()
Dim IE As InternetExplorer, clipboard As Object
Application.ScreenUpdating = False
Set IE = New InternetExplorer
With IE
.Visible = False
.navigate "https://www.nhl.com/blackhawks/stats"
While .Busy Or .readyState < 4: DoEvents: Wend
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText .document.querySelector("#skater-table table").outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
.Quit
End With
Application.ScreenUpdating = True
End Sub
API:
Настоящим золотым прииском для ботаников-статистиков является API.При проверке HTML-кода для страницы я обнаружил этот сценарий, в котором подробно описаны значения на стороне клиента, доступные с помощью API .Вероятно, поэтому был выполнен вызов API на основе queryString.С точки зрения непрофессионала, набор значений, которые вы можете объединить в строку, которую вы отправляете в веб-интерфейс, предоставляет ответ, содержащий все данные статистики, в данном случае в формате JSON .API-интерфейсы, как правило, являются отличным способом получения данных для клиентов и более надежны, чем очистка веб-страниц.
Я решил отслеживать веб-трафик, чтобы узнать, был ли выполнен вызов API, которыйЯ мог бы схватить.Bazinga!Был выполнен следующий вызов API на основе queryString, который возвращает ответ JSON.
https://statsapi.web.nhl.com/api/v1/teams/16?hydrate=franchise(roster(season=20182019,person(name,stats(splits=[yearByYear]))))
Примечание. Если вставить вышеуказанную строку в браузер FireFox и нажать клавишу ввода, вы можете просмотреть ответ JSON.
Прокручивая вниз в FireFox, вы можете найти Джерси № 19, например, и просмотреть их информацию:
Это предоставляет огромное количество статистической информации, возвращаемой в виде строки JSON.Вот лишь краткий обзор того, что содержится внутри (это даже не вся информация для одного показанного игрока!):
вызов API XMLHTTP и JSONпарсинг:
Вы можете вообще не открывать браузер и выдавать действительно быстрый XMLHTTP-запрос на API и получать всю эту информацию в ответе JSON, с которым вы можете работать, используя JSONParser .
В JSON слишком много информации, чтобы показать вам, как ее анализировать.Вот только пример синтаксического анализа всех имен из ответа (обратите внимание, что это полный список сезона).После загрузки и импорта JSONConverter.bas по указанной ссылке вам нужно перейти на VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime.
Option Explicit
Public Sub GetInfo()
Dim strJSON As String, json As Object
Const URL As String = "https://statsapi.web.nhl.com/api/v1/teams/16?hydrate=franchise(roster(season=20182019,person(name,stats(splits=[yearByYear]))))"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
strJSON = .responseText
End With
Set json = JsonConverter.ParseJson(strJSON)("teams")(1)("franchise")("roster")("roster")
Dim player As Object
For Each player In json
Debug.Print player("person")("fullName")
Next
End Sub
Редактировать: В некоторых случаях, похоже, возникают проблемы со ссылкой на буфер обмена с поздним связыванием.Вот общий метод раннего связывания, где hTable является целевым объектом HTMLTable.
Для раннего связывания буфера обмена перейдите в VBE> Инструменты> Ссылки> Библиотека объектов Microsoft-Forms 2.0.
Если вы добавляете пользовательскую форму вваш проект, библиотека будет автоматически добавлена.
Dim clipboard As DataObject
Set clipboard = New DataObject
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial