Объект не поддерживает это свойство или метод

Question

Я следовал учебному пособию и у меня возникла ошибка при выполнении кода, который я скопировал:

Private Sub CommandButton1_Click()

    Dim internet As Object
    Dim internetdata As Object
    Dim div_result As Object
    Dim header_links As Object
    Dim link As Object
    Dim URL As String

    Set internet = CreateObject("InternetExplorer.Application")
    internet.Visible = True

    URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
    internet.navigate URL

    Do Until internet.readyState >= 4
        DoEvents
    Loop

    Application.Wait Now + TimeSerial(0, 0, 5)

    Set internetdata = internet.document
    Set div_result = internetdata.getElementById("res")


    Set header_links = div_result.getElementsByTagName("h3")

    For Each h In header_links
        Set link = h.ChildNodes.Item(0)
        Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
    Next

    MsgBox "done"

End Sub

Ошибка возникает на

Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href

Что здесь не так?

РЕДАКТИРОВАТЬ: код должен дать URL-адреса из поиска Google и написать его в список Excel:

Код скопирован отсюда:

Получение ссылок / URL с веб-страницы-Excel VBA

Answer 1

Если вам нужны только веб-результаты без рекомендуемого контента и ссылок на видео, вы можете использовать их ниже. Также в этом коде вы можете контролировать номер страницы, с которой вы хотите получать ссылки, изменяя переменную pageNo.

Private Sub CommandButton1_Click()

    Dim internet As Object
    Dim internetdata As Object
    Dim div_result As Object
    Dim header_links As Object
    Dim link As Object
    Dim URL As String
    Const pageNo = 10  '0 is page 1, 10 is page 2 and so on  0;10;20;30;40

    Set internet = CreateObject("InternetExplorer.Application")
    internet.Visible = True

    URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
    internet.navigate URL & "&start=" & pageNo

    Do Until internet.readyState >= 4
        DoEvents
    Loop

    Application.Wait Now + TimeSerial(0, 0, 5)

    Set internetdata = internet.document
    Set div_result = internetdata.getElementById("res")
    Set header_links = div_result.getelementsbytagname("h2")

    Dim h As Variant
    For Each div In header_links
        If div.innertext = "Web results" Then
            Set Links = div.ParentElement.getelementsbytagname("a")
            For Each link In Links
                Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
            Next
        End If
    Next
    MsgBox "done"

End Sub

Answer 2

Проблема в том, что Google явно изменил код веб-сайта с момента написания учебника. Этот метод не очень надежен, так как каждый раз, когда Google меняет сайт, он может легко взломать ваш код.

Попробуйте следующее

Set div_result = internetdata.getElementById("res")
Set header_links = div_result.getElementsByTagName("a")

Dim h As Variant
For Each h In header_links
    Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = h.href
Next