vba - 获取 Google 搜索的 URL 结果时出错。

Question

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



这是我使用的代码:

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

下一个