Question

我复制了谷歌的搜索结果，现在想把它贴在Excel上。

我能够把它写到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

Answer 1

通过其他方式使用谷歌而不是手动浏览到搜索页面（目前）是针对他们的Terms of Service（强调我的）：

5.3您同意不访问（或试图访问）任何服务通过以外的任何方式界面由Google提供，除非你是专门的允许单独这样做与谷歌达成协议。 您特别同意不访问（或尝试访问）任何服务通过任何自动化手段（包括使用脚本或网络抓取工具）和应确保您遵守任何robots.txt中都有说明文件存在于服务上。

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

Answer 2

我将假设您只是对通过各种方式感兴趣来完成从Web获取信息到Excel的任务。不是谷歌专门。一种这样的方式发布在下面。但是，正如所指出的那样，我至少存在违反服务条款的风险。如果您使用以下代码，则表示您同意接受所有潜在的责任/风险。提供的代码不供使用，但您可以在有权使用的网站上查看如何执行此任务。

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

如何在Excel VBA中使用Google的搜索结果？

2 个答案: