Question

我是VBA的新手，我认为尝试编码是编码的最佳方式。无论如何，我正在尝试编写一个宏来获取Google搜索结果的第一个网址，但是当搜索结果为0时我收到错误Object variable or With block variable not set，并且会跳过剩余的操作。这是错误图像：

以下是我使用的代码：

Sub XMLHTTP()

   Dim url As String, lastRow As Long
   Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
   Dim start_time As Date
   Dim end_time As Date

   lastRow = Range("A" & Rows.Count).End(xlUp).Row

   Dim cookie As String
   Dim result_cookie As String

   start_time = Time
   Debug.Print "start_time:" & start_time

   For i = 2 To lastRow

      url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

      Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
      XMLHTTP.Open "GET", url, False
      XMLHTTP.setRequestHeader "Content-Type", "text/xml"
      XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
      XMLHTTP.send

      Set html = CreateObject("htmlfile")
      html.body.innerHTML = XMLHTTP.ResponseText
      Set objResultDiv = html.getelementbyid("rso")
      Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
      Set link = objH3.getElementsByTagName("a")(0)


      str_text = Replace(link.innerHTML, "<EM>", "")
      str_text = Replace(str_text, "</EM>", "")

      Cells(i, 2) = str_text
      Cells(i, 3) = link.href
      DoEvents
   Next

   end_time = Time
   Debug.Print "end_time:" & end_time

   Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
   MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

有人可以帮我吗？

Answer 1

在零结果的情况下，H3是空的，所以修改你的代码来处理这种情况

  Set html = CreateObject("htmlfile")
  html.body.innerhtml = XMLHTTP.ResponseText
  Set objResultDiv = html.getelementbyid("rso")

  **numb_H3 = objResultDiv.getElementsByTagName("H3").Length**
  **If numb_H3 > 0 Then**
      Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
      Set link = objH3.getElementsByTagName("a")(0)

      str_text = Replace(link.innerhtml, "<EM>", "")
      str_text = Replace(str_text, "</EM>", "")

      Cells(i, 2) = str_text
      Cells(i, 3) = link.href
  **Else**
  **End If**
  DoEvents

下一步

Answer 2

以下是相同方法的简化代码。

Sub xmlHttp()
    Dim url As String,
        lastRow As Long,
        XMLHTTP As Object, 
        html As Object,
        objResultDiv As Object,
        objH3 As Object,
        link As Object

    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        url = "https://www.google.co.in/search?q=" & Cells(i, 1)
        Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
        xmlHttp.Open "GET", URL, False
        xmlHttp.setRequestHeader "Content-Type", "text/xml"
        xmlHttp.send
        Set html = CreateObject("htmlfile")
        html.body.innerHTML = xmlHttp.ResponseText
        Set objResultDiv = html.getelementbyid("rso")
        numb_H3 = objResultDiv.getElementsByTagName("H3").Length
        If numb_H3 > 0 Then
            Set objH3 = objResultDiv.getElementsByTagName("H3")(0)
            Set link = objH3.getElementsByTagName("a")(0)
            Range(i, 2) = link
        Else
        End If
        DoEvents
    Next
End Sub

Answer 3

一个简单的解决方法 - 尽管不是最好的 - 是跳过错误。

尝试以下修改：

start_time = Time
Debug.Print "start_time:" & start_time

On Error Resume Next '--Add this part.
For i = 2 To lastRow

其他选项包括 true 错误处理部分，当您的搜索没有返回任何内容时返回值。

如果有帮助，请告诉我们。

获取Google搜索的网址结果时出错。

3 个答案: