Wie kann ich Suchergebnisse von Google in Excel VBA verwenden?

Question

Ich kopiere Suchergebnisse von Google und möchte sie nun in Excel einfügen.

Ich war in der Lage, es an den Ort zu schreiben, um in IE zu suchen, aber nicht mehr als es zu verstehen.

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

Die Nutzung von Google auf andere Weise als durch manuelles Aufrufen der Suchseite verstößt (derzeit) gegen die Bedingungen der Dienstleistung (Hervorhebung von mir):

5.3 Sie verpflichten sich, nicht auf die Dienste zuzugreifen (oder zu versuchen, darauf zuzugreifen) mit anderen Mitteln als über die Schnittstelle, die von Google bereitgestellt wird, es sei denn, Ihnen wurde dies ausdrücklich in einer separaten Vereinbarung mit Google Vereinbarung mit Google gestattet. Sie stimmen ausdrücklich zu, nicht auf die Dienste zuzugreifen (oder auf die Dienste zuzugreifen (oder dies zu versuchen) durch automatisierte Mittel (einschließlich Verwendung von Skripten oder Webcrawlern) und müssen sicherstellen, dass Sie die Anweisungen, die in jeder robots.txt Datei in den Diensten enthaltenen Anweisungen einhalten.

Ich bin mir bewusst, dass dies nicht die Lösung für Ihr unmittelbares Problem ist.

Answer 2

Ich gehe davon aus, dass Sie nur an verschiedenen Möglichkeiten interessiert sind, Informationen aus dem Internet in Excel zu übertragen. Nicht speziell an Google. Ein solcher Weg ist unten aufgeführt. Allerdings besteht, wie bereits erwähnt, zumindest das Risiko eines Verstoßes gegen die TOS. Wenn Sie den unten stehenden Code verwenden, erklären Sie sich damit einverstanden, alle potenziellen Haftungsrisiken auf sich zu nehmen. Der zur Verfügung gestellte Code ist nicht zur Verwendung gedacht, sondern damit Sie sehen können, wie Sie diese Aufgabe auf einer Website ausführen können, für die Sie die Erlaubnis zur Verwendung haben.

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

Wenn Sie mit der Robotermethode fortfahren möchten, finden Sie hier eine Anleitung dazu. Es gelten die vorherigen Vorbehalte:

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