Googlesearch结果在Excel中
我有一个很大的excel文件，在A列中有很多string。我希望列B中的Googlesearch结果的确切数量（特别是显示0结果的选项 – 实际上只知道是否存在或不存在结果就足够了）。
我知道这个VBA代码存在于这里从这个网站采取。
但是我遇到了和这些人一样的问题：
我得到它在一个testing工作几次，但现在它说运行时错误'2147024891（80070005）'
那么当我debugging它，它突出search_http.send
哪里不对？
我不是一个高级的Excel用户，也不是一个VBA程序员，所以一些指导将不胜感激。 也许我忽略了一些基本的东西，导致这个错误…
非常感谢，
Mauritz的
我正在使用的代码：
Public Sub ExcelGoogleSearch()Dim searchWords As String With Sheets("Sheet1") RowCount = 1 Do While .Range("A" & RowCount) <> "" searchWords = .Range("A" & RowCount).Value ' Get keywords and validate by adding + for spaces between searchWords = Replace$(searchWords, " ", "+") ' Obtain the source code for the Google-searchterm webpage search_url = "http://www.google.com/search?hl=en&q=""" & searchWords & """&meta=""" Set search_http = CreateObject("MSXML2.XMLHTTP") search_http.Open "GET", search_url, False search_http.send results_var = search_http.responsetext Set search_http = Nothing ' Find the number of results and post to sheet pos_1 = InStr(1, results_var, "resultStats>", vbTextCompare) If pos_1 = 0 Then NumberofResults = 0 Else pos_2 = InStr(3 + pos_1, results_var, ">", vbTextCompare) pos_3 = InStr(pos_2, results_var, "<nobr>", vbTextCompare) NumberofResults = Mid(results_var, 1 + pos_2, (-1 + pos_3 - pos_2)) End If Range("B" & RowCount) = NumberofResults RowCount = RowCount + 1 Loop End With End Sub 我的理解是，xmlhttp在一段时间内有多less连接的限制。 当你错误的时候，只要改变一个不同的xmlhttp对象，你有5个可供select。
该url必须是100％正确的。 不像浏览器没有代码来修复url。
我的程序的目的是获得错误的细节。
如何获得正确的url是在浏览器中input我的url，导航，而正确的url通常在地址栏中。 另一种方法是使用链接的属性等来获取URL。
另外Microsoft.XMLHTTP映射到Microsoft.XMLHTTP.1.0。 HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP映射到Msxml2.XMLHTTP.3.0。 尝试以后一个
用xmlhttp试试这个方法。 编辑url等如果它似乎工作注释如果/结束如果倾倒信息，即使似乎工作。 这是vbscript，但vbscript在vb6中工作。
On Error Resume Next Set File = WScript.CreateObject("Microsoft.XMLHTTP") File.Open "GET", "http://www.microsoft.com/en-au/default.aspx", False 'This is IE 8 headers File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)" File.Send If err.number <> 0 then line ="" Line = Line & vbcrlf & "" Line = Line & vbcrlf & "Error getting file" Line = Line & vbcrlf & "==================" Line = Line & vbcrlf & "" Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description Line = Line & vbcrlf & "Source " & err.source Line = Line & vbcrlf & "" Line = Line & vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText Line = Line & vbcrlf & File.getAllResponseHeaders wscript.echo Line Err.clear wscript.quit End If On Error Goto 0 Set BS = CreateObject("ADODB.Stream") BS.type = 1 BS.open BS.Write File.ResponseBody BS.SaveToFile "c:\users\test.txt", 2
另请参阅这些其他对象是否工作。
C:\Users>reg query hkcr /f xmlhttp HKEY_CLASSES_ROOT\Microsoft.XMLHTTP HKEY_CLASSES_ROOT\Microsoft.XMLHTTP.1.0 HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.3.0 HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.4.0 HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.5.0 HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.6.0 HKEY_CLASSES_ROOT\Msxml2.XMLHTTP HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.3.0 HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.4.0 HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.5.0 HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.6.0 End of search: 12 match(es) found.