运行时错误“91”：对象变量或未设置块

Question

我一直在使用下面的代码，它给了我一个错误 Run Time Error '91' : Object Variable or With Block not Set 我不知道为什么。

之前它工作正常，但我不知道为什么会发生错误。我已经尝试过搜索 Copy URL from the first Search 的其他解决方案，但它们也不起作用。

此行出现错误Set link = ecoll.getElementsByTagName("a")(0)

如果有人可以提供替代解决方案，那将是很大的帮助。任何帮助将不胜感激。

Sub link()
    Dim doc As HTMLDocument
    Set doc = New HTMLDocument
    
    Dim lastrow As Long
    Dim ecoll As Object
    Dim link As Object
    Dim t As Date
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    
    t = Now()
    
    Dim reqObj As Object
    Set reqObj = CreateObject("MSXML2.XMLHTTP")
        
    For i = 2 To lastrow
            
        reqObj.Open "GET", "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000), False
        reqObj.send
        
        doc.body.innerHTML = reqObj.responseText
        
    
        Set ecoll = doc.getElementById("rso")
        Set link = ecoll.getElementsByTagName("a")(0)
            
        Cells(i, 2) = link.href
    Next
    
    Set doc = Nothing
    Set reqObj = Nothing
    
    Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss")
    MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss")
End Sub

Answer 1

需要 cookie 同意，否则您将无法获得预期的搜索结果；至少对我来说，html是不同的。我添加以下标题就足够了：

reqObj.setRequestHeader "cookie", "CONSENT=YES+"
reqObj.setRequestHeader "User-Agent", "Mozilla/5.0"

然后我需要一个不同的 ID：

Set ecoll = doc.getElementById("main")

您的里程可能会有所不同。

那么你需要针对a标签进行更多的区分，否则你会得到很多你几乎肯定不想要的东西。

所以，请尝试删除：

Set link = ecoll.getElementsByTagName("a")(0)

然后使用这个：

Cells(i, 2) = Replace$(ecoll.querySelector("[href*=url]").href, "about:/url?q=", vbNullString)

Answer 2

希望对您有所帮助

首先，看来reqObj.responseText中的html内容不包含任何id为"rso的元素" 完全没有。

进一步，来自“https://www.google.co.in/search?q=”的vba 的响应与browser 中的响应不同。

所以，我尝试做一些技巧来捕捉 google 上显示的第一个搜索结果。

例如，使用关键字“BakPhysio”我们得到这个。

此时我们可以在使用中得到链接Description

.getElementsByTagName("H3")(0).innerText

另一方面，URL链接位于href部分附近，我们在“url?q=”和“&”之间使用substring捕获它

下面的VBA 代码应该会给你一些结果。

Sub link()
    Dim doc As HTMLDocument
    Set doc = New HTMLDocument
    
    Dim lastrow As Long
    Dim ecoll As Object
    Dim Link As Object
    Dim t As Date
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    t = Now()
    
    Dim reqObj As Object
    Set reqObj = CreateObject("MSXML2.XMLHTTP")
        
    For i = 2 To lastrow
        reqObj.Open "GET", "https://www.google.co.in/search?q=" & _
        Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000), False
        reqObj.send
                
        doc.body.innerHTML = reqObj.responseText
        
        
        
      Set all_link = doc.getElementsByTagName("A")
      Dim html, description, Url As String
      Dim start_position, end_position As Integer
      

           For j = 1 To 20 'all_link.Length - 1
              html = all_link(j).outerHTML
              
              If InStr(LCase(html), LCase("/url?q=")) Then
               start_position = InStr(html, "http")
               end_position = InStr(html, "&")
               Url = Mid(html, start_position, end_position - start_position)
                
                    If InStr(LCase(html), LCase("<h3")) Then
                      description = all_link(j).getElementsByTagName("h3")(0).innerText
                      MsgBox description & vbNewLine & Url
                      Cells(i, 2) = Url
                      j = 20 ' Once catching the 1st link, FOR loop is skipped
                End If
              End If
    
           Next j
    Next i
    
    Set doc = Nothing
    Set reqObj = Nothing
    
    Debug.Print "done" & "Time taken : " & Format(Now() - t, "hh:mm:ss")
    MsgBox "Ellapsed Time - " & Format(Now() - t, "hh:mm:ss")

End Sub

[结果]