tags:

views:

646

answers:

3

I copy search results of Google and want to stick it on Excel now.

I was able to write it to the place to search in IE, but do not understand more than it.

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
+3  A: 

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.

I'm aware that this is not solving your immediate problem.

Tomalak
+1  A: 

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.

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
Oorang
A: 

Is it also possible to just count the results instead of showing them ? Just want to make a list of five keywords and count the search results.

Fidler