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

这里错了什么？

编辑：该代码应将网址从Google搜索中排除，并将其写入Excel列表：

代码从此处复制：

Getting Links/URL from a webpage-Excel VBA

Answer 1

问题在于，自编写本教程以来，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

Answer 2

如果您只想获得没有特色内容和视频链接的网络结果，则可以在下面使用。同样在此代码中，您可以通过更改变量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

对象不支持此属性或方法

2 个答案: