如何在Excel VBA中使用Google的search结果?

我复制谷歌的search结果,并希望现在坚持在Excel。

我能够把它写在IE中search的地方,但不了解更多。

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 

我会假设你只是想通过各种方式来完成从网上获取信息到Excel的任务。 不专门Google。 一种这样的方式是张贴在下面。 不过,正如我指出的那样,至less有违反服务条款的风险。 如果您使用下面的代码,您同意接受所有潜在的责任/风险。 提供的代码不能用,但是你可以看到如何在你有权使用的网站上执行这个任务。

 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 

另外,如果你想继续使用机器人方法,下面是如何进行。 以前的注意事项适用于:

 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 

使用Google通过其他手段而不是手动浏览到search页面是(当前)违反他们的服务条款 (重点是我的):

5.3除非通过与Google单独签署的协议明确允许,否则您同意不以任何方式通过Google提供的界面访问(或尝试访问)任何服务。 您明确同意不通过任何自动方式(包括使用脚本或networking爬虫)访问(或尝试访问)任何服务,并应确保您遵守服务中提供的任何robots.txt文件。

我知道这不是解决你眼前的问题。