如何在 Excel VBA 中使用 Google 的搜索结果？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/881502/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How can I use search results of Google in Excel VBA?
提问by freddiefujiwara
I copy search results of Google and want to stick it on Excel now.
我复制了谷歌的搜索结果，现在想把它贴在 Excel 上。
I was able to write it to the place to search in IE, but do not understand more than it.
我是能写到在IE中搜索的地方，但不明白比它多。
Sub get()
With CreateObject("InternetExplorer.application")
.Visible = True
.navigate ("http://www.google.com/")
While .Busy Or .readyState <> 4
DoEvents
Wend
.document.all.q.Value = "keyword"
.document.all.btnG.Click
End With
End Sub
回答by Tomalak
Using Google by other means than manually browsing to the search page is (currently) against their Terms of Service(emphasis mine):
通过手动浏览搜索页面以外的其他方式使用谷歌是（目前）违反他们的服务条款（强调我的）：
5.3 You agree not to access (or attempt to access) any of the Services by any means other than through the interface that is provided by Google, unless you have been specifically allowed to do so in a separate agreement with Google. You specifically agree not to access (or attempt to access) any of the Services through any automated means (including use of scripts or web crawlers)and shall ensure that you comply with the instructions set out in any robots.txt file present on the Services.
5.3 您同意不通过谷歌提供的界面以外的任何方式访问（或试图访问）任何服务，除非您在与谷歌的单独协议中得到明确允许。您明确同意不通过任何自动化方式（包括使用脚本或网络爬虫）访问（或试图访问）任何服务，并应确保您遵守服务中存在的任何 robots.txt 文件中规定的说明.
I'm aware that this is not solving your immediate problem.
我知道这不能解决您当前的问题。
回答by Oorang
I will assume you are just interested in various ways to accomplish the task of getting information from the web into Excel. Not Google specifically. One such way is posted below. However I there is, as pointed out, at least a risk of violated a TOS. If you use the code below you agree to accept all potential liability/risk onto yourself. Code provided is not for use but so you can see how to perform this task on a site you have permission to use.
我假设您只是对完成从 Web 获取信息到 Excel 的任务的各种方法感兴趣。不是专门的谷歌。下面发布了一种这样的方式。但是，正如所指出的那样，至少存在违反 TOS 的风险。如果您使用下面的代码，即表示您同意自己承担所有潜在的责任/风险。提供的代码不供使用，但您可以查看如何在您有权使用的站点上执行此任务。
Option Explicit
Sub Example()
Dim strKeyword As String
Dim lngStartAt As Long
Dim lngResults As Long
Dim ws As Excel.Worksheet
On Error GoTo Err_Hnd
LockInterface True
lngStartAt = 1
lngResults = 100
strKeyword = "Google TOS"
Set ws = Excel.ActiveSheet
ws.UsedRange.Delete
With ws.QueryTables.Add("URL;http://www.google.com/search?q=" & strKeyword & "&num=100&start=" & lngStartAt & "&start=" & lngResults, ws.Cells(1, 1))
.Name = "search?q=" & strKeyword
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebDisableDateRecognition = False
.Refresh False
End With
StripHeader ws
StripFooter ws
Normalize ws
Format ws
Exit_Proc:
On Error Resume Next
LockInterface False
Exit Sub
Err_Hnd:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
Resume Exit_Proc
Resume
End Sub
Private Sub StripHeader(ByRef ws As Excel.Worksheet)
Dim rngSrch As Excel.Range
Dim lngRow As Long
Set rngSrch = Intersect(ws.UsedRange, ws.Columns(1))
lngRow = rngSrch.Find("Search Results", ws.Cells(1, 1), xlValues, xlWhole, _
xlByColumns, xlNext, True, SearchFormat:=False).row
ws.Rows("1:" & CStr(lngRow + 1&)).Delete
End Sub
Private Sub StripFooter(ByRef ws As Excel.Worksheet)
Dim lngRowCount As Long
lngRowCount = ws.UsedRange.Rows.Count
ws.Rows(CStr(lngRowCount - 6&) & ":" & CStr(lngRowCount)).Delete
End Sub
Private Sub Normalize(ByRef ws As Excel.Worksheet)
Dim lngRowCount As Long
Dim lngRow As Long
Dim lngLastRow As Long
Dim lngDPos As Long
Dim strNum As String
lngRowCount = ws.UsedRange.Rows.Count
ws.Cells(1&, 2&).Value = ws.Cells(3&, 1&).Value
lngLastRow = 1&
For lngRow = 2& To lngRowCount
lngDPos = InStr(ws.Cells(lngRow, 1).Value, ".")
If lngDPos Then
If IsNumeric(Left$(ws.Cells(lngRow, 1).Value, lngDPos - 1&)) Then
ws.Cells(lngRow, 2&).Value = ws.Cells(lngRow + 2&, 1).Value
ws.Hyperlinks.Add ws.Cells(lngLastRow, 1&), "http://" & Left$(ws.Cells(lngRow - 2&, 1).Value, InStr(ws.Cells(lngRow - 2&, 1).Value, " ") - 1&)
lngLastRow = lngRow
End If
End If
Next
ws.Hyperlinks.Add ws.Cells(lngLastRow, 1&), "http://" & Left$(ws.Cells(lngRow - 1&, 1).Value, InStr(ws.Cells(lngRow - 2&, 1).Value, " ") - 1&)
For lngRow = lngRowCount To 1& Step -1&
If LenB(ws.Cells(lngRow, 2).Value) = 0& Then ws.Rows(lngRow).Delete
Next
End Sub
Private Sub Format(ByRef ws As Excel.Worksheet)
With ws.UsedRange
.ColumnWidth = 50
.WrapText = True
.Rows.AutoFit
End With
ws.Rows(1).Insert
ws.Cells(1, 1).Value = "Result"
ws.Cells(1, 2).Value = "Description"
End Sub
Public Sub LockInterface(ByVal lockOn As Boolean)
Dim blnVal As Boolean
Static blnOrgWIT As Boolean
With Excel.Application
If lockOn Then
blnVal = False
blnOrgWIT = .ShowWindowsInTaskbar
.ShowWindowsInTaskbar = False
Else
blnVal = True
.ShowWindowsInTaskbar = blnOrgWIT
End If
.DisplayAlerts = blnVal
.EnableEvents = blnVal
.ScreenUpdating = blnVal
.Cursor = IIf(blnVal, xlDefault, xlWait)
.EnableCancelKey = IIf(blnVal, xlInterrupt, xlErrorHandler)
End With
End Sub
Also, if you want to proceed to with the robot method, here is how to proceed. Previous caveats apply:
此外，如果您想继续使用机器人方法，这里是如何继续。以前的警告适用：
Sub RobotExample()
Dim ie As SHDocVw.InternetExplorer 'Requires reference to "Microsoft Internet Controls"
Dim strKeyword As String
Dim lngStartAt As Long
Dim lngResults As Long
Dim doc As MSHTML.HTMLDocument 'Requires reference to "Microsoft HTML Object Library"
Set ie = New SHDocVw.InternetExplorer
lngStartAt = 1
lngResults = 100
strKeyword = "Google TOS"
ie.navigate "http://www.google.com/search?q=" & strKeyword & _
"&num=100&start=" & lngStartAt & "&start=" & lngResults
Do Until ie.readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set doc = ie.document
MsgBox doc.body.innerText
ie.Quit
End Sub
