Excel'Google搜索'代码随机破解:运行时错误'91'

时间:2015-01-22 19:38:20

标签: excel vba excel-vba excel-2007 google-search

这是我目前的代码,来自论坛上的多个人。通常它适用于大约100个搜索结果,然后给我“运行时错误'91'” 我开始认为它与谷歌有关,而不是实际的代码,因为它非常随机发生 感谢

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")

  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

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

2 个答案:

答案 0 :(得分:1)

你应该使用if语句:

 If XMLHTTP.waitForResponse(WAIT_TIMEOUT) Then 'response ready
  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
End If

答案 1 :(得分:0)

我遇到了同样的问题,似乎确实是谷歌。打开VPN解决了这个问题,因此代码本身没有任何问题。