How to export Google search results

Question

I want a list of the Titles and URLs for the search results of a particular query. In my particular situation, there are only about 20 pages of results so it's not that much data.

Answer 1

I don't know about google but I know bing has an option to export any search page as rss. You simply add format=rss to the query string. For instance

http://www.bing.com/search?q=london&format=rss

This will give 10 result per page so for the second page you add

http://www.bing.com/search?q=london&format=rss&first=11

and the third

http://www.bing.com/search?q=london&format=rss&first=21

and so on...

Answer 2

I ended up cutting and pasting HTML from the search results and then using jQuery to pull out the titles and URLs.

Answer 3

I would suggest a modification of Error on getting the URL result of a Google search for 200 results, using Excel.

Copy and paste the code in an Excel module (Alt+F11, right button on left panel VBAProject, insert module). Go to the tools menu, references, and select Microsoft Internet controls, Microsoft XML 6.0, Microsoft HTML object library.

Having your queries in the A column in a sheet of the document, click on the play button of the module window to run the code.

Sub XMLHTTP8()

Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, link As Object, objH3 As Object
Dim start_time As Date
Dim end_time As Date
Dim vN As Variant
lastRow = Range("A" & Rows.Count).End(xlUp).row

Dim cookie As String
Dim result_cookie As String

start_time = Time
Debug.Print "start_time:" & start_time


For i = 1 To lastRow
c = 0
d = 1

vN = Array("", "&start=100")
For u = LBound(vN) To UBound(vN)
url = "https://www.google.com/search?num=100" & vN(u) & "&site=webhp&source=hp&q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.responseText
    Set objResultDiv = html.getElementById("rso")
    If objResultDiv.innerText = "" Then Exit For

                Set objH3 = objResultDiv.getElementsByTagName("H3")
                     For Each objH3sep In objH3
                     On Error Resume Next
                     Set link = objH3sep.getElementsByTagName("a")(0)
                     str_text = Replace(link.innerHTML, "<EM>", "")
                     str_text = Replace(str_text, "</EM>", "")
                     c = c + 2
                     d = d + 2
                     Cells(i, c) = str_text
                     Cells(i, d) = link.href
                     Next
    DoEvents
Next
Next

With ActiveSheet
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select
Selection.Copy
Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Results"
Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
    With Selection
    .ColumnWidth = 95
    .wraptext = True
    End With

For Each xCell In Selection
If InStr(1, xCell.text, "http://") > 0 Then
correct = Replace(xCell.text, "http://", "")
xCell.Value = correct
ActiveSheet.Hyperlinks.Add anchor:=xCell, Address:="http://" & xCell.Value
ElseIf InStr(1, xCell.Value, "https://") > 0 Then
correct = Replace(xCell.Value, "https://", "")
xCell.Value = correct
ActiveSheet.Hyperlinks.Add anchor:=xCell, Address:="https://" & xCell.Value
End If
Next xCell

End With

end_time = Time


Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub