VBA HTML Scraping Ошибка «Переменная объекта или переменная не установлена»

Question

Я следовал учебному пособию по этому видео https://www.youtube.com/watch?v=sGw6r5GVA5g&t=2803s, сделанному каналом WiseOwlTutorials, и застрял в процедуре листинга, которую он объясняет в позиции видео на 36:00.

В этот моментон начинает объяснять, как вернуть URL видео и имя списка видео из определенной категории с помощью итерационного метода Sub ListVideosOnPage(VidCatName As String, VidCatURL As String), используемого в другом модуле, который просматривает все категории видео главной видео страницы своего веб-сайта 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нацелить на стилизацию страницы.Это , как правило, быстрее , более надежный и гибкий;
3. VidCatName, похоже, не используется, но я ушел пока.Я лично удалил бы, если позже вы не разработаете код для использования этой переменной.Вторые подпараметры передаются по значению , поэтому я добавил 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 для нацеливания элементов тега a в целевом родительском элементе table.Это записано как .bpTable a.Более официальным термином для этой комбинации является селектор потомков .

Комбинатор-потомок - обычно представляемый одним символом пробела () - объединяет два селектора, так что элементы, соответствующие второму селектору, выбираются, если у них есть элемент-предок, соответствующийПервый селектор.Селекторы, которые используют комбинатор-потомок, называются селекторами-потомками.

* * * * * * * .bpTable на самом деле является селектором класса (как .getElementsByClassName).Классная часть обозначена ведущим ".".Итак, элементы с именем класса bpTable;который является именем класса целевой таблицы на каждой странице.

Элемент целевой таблицы на странице:

Этот селектор применяется с помощью .querySelectorAll метода .document и возвращает статический nodeList.Затем вы можете зациклить .Length этого nodeList с 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