Переменная объекта VBA не задана - HTML Scraping

Question

Я пытаюсь очистить Google, и у меня возникают проблемы с извлечением нескольких элементов из сегментов HTML.Google представляет каждый результат поиска как «карточный» класс.Я продолжаю получать ошибку «Переменная объекта не установлена», когда я запускаю следующий код.

> Option Explicit
> 
> Sub StatusLetter()
>     SearchandScrape ("Apple") End Sub
> 
> Sub SearchandScrape(URL As String)
>     Dim IE As New SHDocVw.InternetExplorer
>     Dim HTMLDoc As MSHTML.HTMLDocument
>     Dim HTMLCard As MSHTML.IHTMLElement
>     Dim HTMLCards As MSHTML.IHTMLElementCollection
>     Dim Temp As MSHTML.IHTMLElement
>     Dim scrapedCard As New card
>     
>     IE.Visible = True
>     IE.navigate "https://www.google.com/search?q=" & URL & "&tbm=nws&source=lnt&tbs=qdr:d&sa=X&ved=0ahUKEwjf_LHL1bngAhXqQ98KHTs2D4QQpwUIHw&biw=1282&bih=893&dpr=1"
>         
>     Do While IE.readyState <> READYSTATE_COMPLETE
>     Loop
>     
>     Set HTMLDoc = IE.Document
>     
>     Set HTMLCards = HTMLDoc.getElementsByClassName("card")
>     
>     For Each HTMLCard In HTMLCards
>         Temp = HTMLCard.getElementsByTagName("h3")(0)
>         Debug.Print Temp.innerText
>     Next End Sub

Я получаю сообщение об ошибке для каждого цикла.Я хочу иметь возможность вытащить текст из 3 тегов, который хранится в сегменте HTML.2 из них - это пролеты, а третий - h3 для каждой карты в картах HTMLC.Любые рекомендации по исправлению для этого.Я не могу понять, как правильно получить доступ к этим объектам.Спасибо!

Answer 1

Используйте правильное ожидание загрузки страницы.Не забудьте закрыть приложение после.На странице есть только один элемент с таким именем класса.Я думаю, что вы на самом деле хотите другой селектор, как показано ниже.

Option Explicit    
Public Sub StatusLetter()
    SearchandScrape "Apple"
End Sub

Public Sub SearchandScrape(URL As String)
    Dim IE As SHDocVw.InternetExplorer, headlines As Object, i As Long
    Dim agenciesAndTime As Object, agencies As Object, times As Object, descriptions As Object
    Set IE = New SHDocVw.InternetExplorer
    With IE
        .Visible = True
        .Navigate2 "https://www.google.com/search?q=" & URL & "&tbm=nws&source=lnt&tbs=qdr:d&sa=X&ved=0ahUKEwjf_LHL1bngAhXqQ98KHTs2D4QQpwUIHw&biw=1282&bih=893&dpr=1"

        While .Busy Or .readyState < 4: DoEvents: Wend
        Set headlines = .document.querySelectorAll("h3.r")
        Set agenciesAndTime = .document.querySelectorAll("h3.r + div span")
        Set agencies = .document.querySelectorAll("h3.r + div span:nth-of-type(1)")
        Set times = .document.querySelectorAll("h3.r + div span:nth-of-type(3)")
        Set descriptions = .document.querySelectorAll("#ires div.st")
        Dim results(), headers()
        headers = Array("Headline", "Agency&Time", "Agency", "Time", "Description")
        ReDim results(1 To headlines.Length, 1 To 5)

        If headlines.Length > 0 Then
            For i = 0 To headlines.Length - 1
                results(i + 1, 1) = headlines.item(i).innerText
                results(i + 1, 2) = agenciesAndTime.item(i).innerText
                results(i + 1, 3) = agencies.item(i).innerText
                results(i + 1, 4) = times.item(i).innerText
                results(i + 1, 5) = descriptions.item(i).innerText
            Next
        End If
        .Quit
        With ThisWorkbook.Worksheets("Sheet1")
            .Cells.ClearContents
            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
            .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        End With
    End With
End Sub