VBA Web Scrape 按类名类型不匹配错误获取元素

Question

我正在尝试使用以下代码使用 VBA 从 NHL 统计数据中提取一些数据到 Excel 中，但出现类型不匹配错误。有任何想法吗？

代码：

Private Sub Hawks()

    Dim IE As New InternetExplorer
    Dim element As HTMLAnchorElement
    Dim elements As HTMLElementCollection

    IE.Visible = False
    IE.navigate "https://www.nhl.com/blackhawks/stats"

    Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE

    Dim Doc As HTMLDocument
    Set Doc = IE.document
    Set elements = Doc.getElementsByClassName("name-col__firstName")

    Dim count As Long

    Dim erow As Long
    count = 0

    For Each element In sDD
    If element.className = "name-col__firstName" Then
    erow = Sheet1.Cells(Rows.count, 1).edn(xlUp).Offset(1, 0).Row
    Cells(erow, 1) = HTML.getElementsByTagName("span")(count).innerText
    count = count + 1
    End If
    Next element

End Sub

Answer 1

您的代码：

也许您合并了单独的代码位，但您对变量的使用不一致。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元素 id来定位表，然后通过其类属性的值来定位实际名称。这是一种通过关闭屏幕更新进一步优化代码的快速方法。

这些名称都位于一个 id 为 的表中skater-table。其 CSS 选择器是#skater-table. 在#表示ID。在这个父表 id 元素中，名称本身都有一个包含字符串 value 的 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。在检查页面的 HTML 时，我发现这个脚本详细说明了API提供的客户端值。因此，似乎有一个基于 queryString 的 API 调用。通俗地说，一组值可以组合成一个字符串，然后发送到 Web 界面，它提供包含所有统计数据的响应，在这种情况下，采用称为JSON的格式。API 通常是客户端获取数据的好方法，并且比网络抓取更可靠。

我决定监控网络流量，看看是否进行了可以抓取的 API 调用。巴辛加！进行了以下基于 queryString 的 API 调用，该调用返回 JSON 响应。

https://statsapi.web.nhl.com/api/v1/teams/16?hydrate=franchise(roster(season=20182019,person(name,stats(splits=[yearByYear]))))

注意：如果您将上述字符串粘贴到 FireFox 浏览器中并按 Enter，您可以浏览 JSON 响应。

例如，在 FireFox 中向下滚动您可以找到 Jersey 号码 19，并查看他们的信息：

这公开了以 JSON 字符串形式返回的大量统计信息。这里只是一瞥其中包含的内容（这甚至不是显示的一个玩家的所有信息！）：

XMLHTTP API 调用和 JSON 解析：

您可以完全避免打开浏览器并针对 API发出非常快速的XMLHTTP 请求，并在 JSON 响应中获取所有这些信息，然后您可以使用JSONParser 进行处理。

JSON 中的信息太多，无法向您展示如何解析所有内容。这里只是一个从响应中解析所有名字的例子（注意这是一个完整的季节列表）。从给定的链接下载并导入 JSONConverter.bas 后，您需要转到 VBE > Tools > References > Add a reference to 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