Excel 中的 Google 搜索结果答案

【问题标题】：Google Search Results in ExcelExcel 中的 Google 搜索结果
【发布时间】：2016-05-17 23:30:45
【问题描述】：

我有一个大的 Excel 文件，A 列中有很多字符串。我想要 B 列中 Google 搜索结果的确切数量（尤其是显示 0 个结果的选项 - 事实上，只知道结果是否存在就足够了）。

我知道存在用于此的 VBA 代码 here 取自 website。

但是我和这些评论的人有同样的问题：

我让它在测试中工作了几次，但现在它说运行时错误'2147024891（80070005）'

然后当我调试它时，它会突出显示 search_http.send

怎么了？

我不是高级 Excel 用户，也不是 VBA 程序员，因此不胜感激。也许我忽略了产生此错误的基本内容...

非常感谢，

毛里茨

我正在使用的代码：

    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

【问题讨论】：

标签： vba excel search-engine

【解决方案1】：

我的理解是xmlhttp对一段时间内的连接数是有限制的。出错时只需更改为不同的 xmlhttp 对象，您有 5 个可供选择。

网址必须 100% 正确。与浏览器不同，它没有修复 url 的代码。

我的程序的目的是获取错误详细信息。

如何获得正确的 URL 是在浏览器中键入我的 url，导航，正确的 URL 通常在地址栏中。另一种方法是使用链接的属性等来获取 URL。

Microsoft.XMLHTTP 也映射到 Microsoft.XMLHTTP.1.0。 HKEY_CLASSES_ROOT\Msxml2.XMLHTTP 映射到 Msxml2.XMLHTTP.3.0。稍后再试

使用 xmlhttp 试试这个方法。编辑网址等。如果它似乎工作注释掉 if / end if to dump info 即使看起来工作。它是 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.

还要注意，在锁定发生之前，您可以调用任何特定 XMLHTTP 对象的次数是有限制的。如果发生这种情况，并且在调试代码时确实如此，只需更改为不同的 xmlhttp 对象

【讨论】：