How to use Google search results in Excel VBA?

Question

I copy Google search results and want to paste it into Excel now.

I was able to write it to a place to search in IE, but I do not understand it anymore.

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

, Excel. Google . . , , 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

, , . :

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

Answer 2

Google , ( ) ( ):

5.3 ( ) , , Google, Google. ( ) ( -) , robots.txt , .

, .