Question

我尝试了很多教程并花了很多时间在堆栈溢出上试图解决这个问题，但是却找不到答案。

我在使用excel的VBA新手，并且一直在尝试将自动网络搜索到excel中，从一列单元格中获取查询并将结果中的元素写入另一行单元格。为了简化此示例，我使用了Google搜索。

我总是得到同样的信息：

运行时错误＆＃39; 91＆＃39;对象变量或With Block变量未设置

这是代码的最新版本：

Sub Macro1()

 Dim ie As Object
 Set Rng = Range("A3:A5")

Set Row = Range(Rng.Offset(1, 0), Rng.Offset(1, 0).End(xlDown))

Set ie = CreateObject("InternetExplorer.Application")
With ie
    .Visible = True
    For Each Row In Rng
    .navigate "https://www.google.com/#q=" & Range("A" & Row.Row).Value

Do
    DoEvents
        Loop Until ie.readyState = READYSTATE_COMPLETE

        Dim doc As HTMLDocument
        Set doc = ie.document
        While ie.readyState <> 4

Wend

Range("B" & Row.Row) = doc.getElementById("resultStats" & Range("A" & Row.Row).Value).innerText

Next Row

ie.Quit

End With

End Sub

非常感谢任何帮助。

谢谢，

Answer 1

它无法正常工作的原因是因为Google上没有名为“resultStats YOURVALUEHERE ”的ID元素。 getElementById("resultStats")将返回结果数量，例如如果您在Google上搜索VBA，则会获得36,100,000结果此外，您应该使用Option Explicit。

如果要返回“标题”和“URL”，可以执行此操作。但是，A3中只能有1个值 - 但这当然可以修改。

Option Explicit

Sub Macro1()
Dim rng As Range, Cell As Range
Dim i As Integer
Dim IE As Object, objDiv As Object, objH3 As Object, objLink As Object
Dim strText As String

Set rng = Range("A3:A5")

Set Cell = Range(rng.Offset(1, 0), rng.Offset(1, 0).End(xlDown))

Set IE = CreateObject("InternetExplorer.Application")

    With IE
        .Visible = False ' Change to True if you want to open IE and have it visible

        For Each Cell In rng
        .navigate "https://www.google.com/#q=" & Range("A" & Cell.row).value

        Do
            DoEvents
                Loop Until IE.readyState = READYSTATE_COMPLETE

                Dim doc As HTMLDocument
                Set doc = IE.document
                While IE.readyState <> 4
        Wend

            ' Add the 5 first results to rows
            For i = 0 To 4
                Set objDiv = doc.getElementById("rso")
                Set objH3 = objDiv.getElementsByTagName("H3")(i)
                Set objLink = objH3.getElementsByTagName("a")(0)

                strText = Replace(objLink.innerHTML, "<EM>", "")
                strText = Replace(strText, "</EM>", "")

                Dim CellRow As Integer
                If i = 0 Then
                    CellRow = Cell.row
                Else
                    CellRow = CellRow + 1
                End If

                ' Insert values starting in B3 and C3 and continue with B4, C4, for the next value etc.
                Cells(CellRow, 2) = strText
                Cells(CellRow, 3) = objLink.href
            Next i

        Next Cell

    IE.Quit

    End With
End Sub

VBA Excel 2010运行时错误＆＃39; 91＆＃39;对象变量或With Block变量未设置

1 个答案: