获取Googlesearch的url结果时出错。
我是VBA的新手，我认为尝试编写代码是最好的编码方式。 无论如何，我试图编写一个macros，将获得谷歌search结果的第一个url，但我得到错误的Object variable or With block variable not setsearch结果为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
任何人都可以帮我吗？
这里是相同方法的简化代码。
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
在零结果的情况下，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
下一个
一个简单的解决方法 – 虽然不是最好的 – 是跳过错误。
尝试以下修改：
start_time = Time Debug.Print "start_time:" & start_time On Error Resume Next '--Add this part. For i = 2 To lastRow
其他选项包括一个真正的error handling部分，当你的search没有返回任何东西时返回一个值。
让我们知道这是否有帮助。