VBA HTML 抓取错误“对象变量或未设置变量”

Question

我正在关注 WiseOwlTutorials 频道制作的此视频 https://www.youtube.com/watch?v=sGw6r5GVA5g&t=2803s 的教程，但卡在了他在视频 36:00 位置解释的列表过程中。

此时，他开始解释如何通过称为 Sub ListVideosOnPage(VidCatName As String, VidCatURL As String) 的迭代方法从特定类别返回视频 url 和视频列表的名称，该方法在另一个模块中使用，该模块循环遍历其网站主视频的所有视频类别页面https://www.wiseowl.co.uk/videos（左角菜单列表）。

当此过程开始时，它会进入每个视频类别并从该类别中获取每个视频的名称和 url，以便将其列在一个页面上，在上面引用的 Youtube 视频的那部分中，该页面是一个调试页面.但是，实际的 WiseOwl 视频页面与制作教程视频时的页面不同。

所以，我稍微改变了他的方法，以便在 debbugin 页面上放置正确的元素，如下所示：

Sub ListVideosOnPage(VidCatName As String, VidCatURL As String)

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument

Dim VidTables As MSHTML.IHTMLElementCollection
Dim VidTable As MSHTML.IHTMLElement
Dim VidRows As MSHTML.IHTMLElementCollection
Dim VidRow As MSHTML.IHTMLElement
Dim VidLink As MSHTML.IHTMLElement    

    XMLReq.Open "GET", VidCatURL, False
    XMLReq.send

    If XMLReq.Status <> 200 Then
        MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
        Exit Sub
    End If

    HTMLDoc.body.innerHTML = XMLReq.responseText
        'get the table element in each video category found by other module
        'VidTables tag added by me to get the new element on the WiseOwl website
        Set VidTables = HTMLDoc.getElementsByTagName("table")
        'loop starts to search for row and link tags on the current table
        For Each VidTable In VidTables
            Set VidRows = VidTable.getElementsByTagName("tr")
            For Each VidRow In VidRows
                Set VidLink = VidRow.getElementsByTagName("a")(0) 'just pick the first link
                Debug.Print VidRow.innerText, VidRow.getattribute("href") 'objetc variable not set error happpens here
            Next VidRow
        Next VidTable           
End Sub

我找到了一种绕过Object Variable or With Variable not set 错误的方法，方法是更改​​ vidrow 循环内的代码，在代码中添加手动索引以仅获取每行中的第一个链接：

       For Each VidTable In VidTables
            Set VidRows = VidTable.getElementsByTagName("tr")
            For Each VidRow In VidRows
                Index = 0
                For Each VidLink In VidLinks
                   If Index = 0 Then
                            Debug.Print VidLink.innerText, VidLink.getAttribute("href")
                            Index = Index + 1
                   End If
                Next VidLink
            Next VidRow
        Next VidTable

但是，在上面引用的教程视频中，当讲师以如下所示的方式编码索引时，并没有出现此错误：

        VidLink = VidRow.getElementsByTagName("a")(0) 
        Debug.Print VidRow.innerText, VidRow.getattribute("href")

所以我的问题是如何让这些对象变量未设置错误，而在教程视频中教师没有？对我来说看起来像相同的代码，每个元素都以正确的方式定义，并且比使用 if 更有效地编写代码。有没有人更习惯 VBA 请帮忙回答这个问题？也许我错过了什么。

Answer 1

tl:dr:

1. 我先给你调试和修复信息；
2. 我将继续向您展示一种使用 CSS 选择器来定位页面样式的不同方式。这是generally faster，更健壮、更灵活；
3. VidCatName 似乎没有被使用，但我现在已经离开了。我个人会删除，除非您稍后开发代码以使用此变量。第二个子参数是passed by value，所以我在签名中添加了ByVal。

---

① 调试：

您的错误是因为您正在循环 所有 表行并尝试访问 a 标记，然后是 href 属性。每个表的第一行是标题行，它没有a 标签元素，也没有关联的href 属性。见下图：

页面上的表格元素：

看到表中的第一个tr标签元素包含一个th标签子元素，表明它是表头，并且没有关联的a标签元素。

就像您在该视频的其他地方看到的一样，您想将循环更改为 For Next，然后在这种情况下，从索引 1 开始跳过标题行。

因此，包含这一行的部分：For Each VidRow In VidRows，变为以下内容：

Dim VidRowID As Long
For Each VidTable In VidTables
    Set VidRows = VidTable.getElementsByTagName("tr")
    For VidRowID = 1 To VidRows.Length - 1 'first row is actually header which doesn't have an a tag or href
        Set VidLink = VidRows(VidRowID).getElementsByTagName("a")(0) 
        Debug.Print VidLink.innerText, VidLink.getAttribute("href") 
    Next VidRowID
Next VidTable

每页也只有一个表，因此在这种情况下，所有表的循环都是不必要的代码。

---

完整调用示例（使用仅更改循环类型的代码）：

Option Explicit        
Public Sub test()    
    ListVideosOnPage "Business Intelligence (70)", "https://www.wiseowl.co.uk/business-intelligence/videos/"    
End Sub

Public Sub ListVideosOnPage(ByVal VidCatName As String,ByVal VidCatURL As String)  
    Dim XMLReq As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument    
    Dim VidTables As MSHTML.IHTMLElementCollection
    Dim VidTable As MSHTML.IHTMLElement
    Dim VidRows As MSHTML.IHTMLElementCollection
    Dim VidRow As MSHTML.IHTMLElement
    Dim VidLink As MSHTML.IHTMLElement

    XMLReq.Open "GET", VidCatURL, False
    XMLReq.send

    If XMLReq.Status <> 200 Then
        MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
        Exit Sub
    End If

    HTMLDoc.body.innerHTML = XMLReq.responseText
    Set VidTables = HTMLDoc.getElementsByTagName("table") 'Should limit to just one table
    Dim VidRowID As Long
    For Each VidTable In VidTables
        Set VidRows = VidTable.getElementsByTagName("tr")
        For VidRowID = 1 To VidRows.Length - 1 'first row is actually header which doesn't have an a tag or href
            Set VidLink = VidRows(VidRowID).getElementsByTagName("a")(0) 
            Debug.Print VidLink.innerText, VidLink.getAttribute("href") 
        Next VidRowID
    Next VidTable
End Sub

---

② CSS选择器：

我会改为使用CSS selector combination 来定位目标父table 元素中的a 标记元素。这写为.bpTable a。这种组合的更正式的术语是descendant selector。

后代组合符 — 通常由一个空格 ( ) 字符 — 组合两个选择器，以便匹配的元素 如果它们具有匹配的祖先元素，则选择第二个选择器 第一个选择器。使用后代组合器的选择器是 称为后代选择器。

.bpTable 实际上本身就是一个class selector（如.getElementsByClassName）。由前导"." 指示的类部分。所以，类名bpTable的元素；即每页目标表的类名。

页面上的目标表格元素：

此选择器通过.document 的.querySelectorAll 方法应用并返回静态nodeList。然后你可以循环这个nodeList的.Length，从0到.Length -1，通过索引访问元素。

Public Sub ListVideosOnPage(ByVal VidCatName As String, ByVal VidCatURL As String)
    Dim XMLReq As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument

    XMLReq.Open "GET", VidCatURL, False
    XMLReq.send

    If XMLReq.Status <> 200 Then
        MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
        Exit Sub
    End If
    HTMLDoc.body.innerHTML = XMLReq.responseText

    Dim aNodeList As Object, link As Long
    Set aNodeList = HTMLDoc.querySelectorAll(".bpTable a")
    For link = 0 To aNodeList.Length - 1
        Debug.Print aNodeList(link).innerText, aNodeList(link).href
    Next
End Sub

---

参考资料（VBE > 工具 > 参考资料）：

1. Microsoft HTML 对象库
2. Microsoft XML, V6.0 '适用于我的 Excel 2016 版本