VBA Express : Excel - Searching Google by Excel

Excel

Searching Google by Excel

Ease of Use

Hard

Version tested with

2003

Submitted by:

Paleo

Description:

Sometimes you need to know if there are sites about some topic, this code shows you the top ten.

Discussion:

When you are working sometimes you need to know if there are any sites about a certain topic, using this code you will find the top ten, getting their title and URL.

Code:

instructions for use

			Private Sub cmdSearch_Click() 
    Dim cb As ComboBox, TamI As Integer, TamF As Integer, Inic As Integer 
    Dim ResultadoConsulta As String, Pag As String, Add As String 
    Dim strSearch As String, Parcial As String, meuArray(9, 1) As String 
    Set ObjXML = CreateObject("Microsoft.XMLHTTP") 
    Set cb = cboResults 
    cb.Clear 
    strSearch = Range("B2") 
    ObjXML.Open "GET", "http://www.google.com.br/search?hl=US&q=" & strSearch & "&meta=", False 
    ObjXML.Send 
    ResultadoConsulta = ObjXML.ResponseText 
    Inic = InStr(1, ResultadoConsulta, "seconds)") 
    For i = 0 To 9 
        TamI = InStr(1, ResultadoConsulta, "return clk(this,'res'," & i + 1) + 26 
        TamF = InStr(TamI, ResultadoConsulta, "</a>") 
        Pag = Mid(ResultadoConsulta, TamI, TamF - TamI) 
        Pag = Replace(Pag, "<b>", "") 
        Pag = Replace(Pag, "</b>", "") 
        Pag = Replace(Pag, ">", "") 
        Pag = Replace(Pag, "<", "") 
        TamI = InStr(Inic + 1, ResultadoConsulta, "<a href") + 8 
        TamF = InStr(TamI, ResultadoConsulta, " ") 
        Inic = TamF 
        Parcial = Mid(ResultadoConsulta, TamI, TamF - TamI) 
        If InStr(1, Parcial, "translate") = 0 And InStr(1, Parcial, "related") = 0 _ 
        And InStr(1, Parcial, "search") = 0 Then 
            Add = Parcial 
            meuArray(i, 0) = Pag 
            meuArray(i, 1) = Add 
        Else 
            i = i - 1 
        End If 
    Next 
    cb.List() = meuArray 
    Range("A7") = "" 
End Sub 
 
Private Sub cboResults_Change() 
    Dim Texto As String 
    On Error Resume Next 
    Texto = Range("a7") 
    On Error GoTo 0 
    ActiveSheet.Hyperlinks.Add Range("A7"), Texto 
End Sub

How to use:

Copy the above code.
Open any workbook.
Press Alt + F11 to open the Visual Basic Editor (VBE).
Press Ctrl + R to show the Project Explorer.
Right-click desired file on left (in bold).
Double-click the plan where you want to have the ComboBox control
Paste the code into the right-hand code window.
Close the VBE, save the file if desired.
Insert a ComboBox in the plan and set the following properties: BoundColumn=2; ColumnCount=2; ColumnWidths=;0; LinkedCell=A7 (or the cell you want).
Insert a CommandButton and set its name to: cmdSearch
Click the button

Test the code:

Type the expression to search in cell B2
Click the CommandButton
Choose a site by its title from the ComboBox
Check its URL at cell A7

Sample File:

GoogleSearch.zip 13.35KB

Approved by mdmackillop

This entry has been viewed 354 times.