Excel VBA to open first page of google search results

I need to open google search page using excel Macro. I can successfully open google search page after i give search options in excel. However, my task is to open the first page of the returned search results and do some data extractions on that page. I used the below code.

Suppose if I searched for the " Sachin Tendulkar wiki ", I would have to open the first page in the search results. My code is below so far.

Dim ie As InternetExplorer
Dim RegEx As RegExp, RegMatch As MatchCollection
Dim MyStr As String
Dim pDisp As Object
Set ie = New InternetExplorer
Set RegEx = New RegExp
Dim iedoc As Object

'Search google for "something"
ie.Navigate "http://www.google.com.au/search?hl=en&q=sachin+tendulkar+wiki&meta="

'Loop unitl ie page is fully loaded
Do Until ie.ReadyState = READYSTATE_COMPLETE
Loop



MyStr = ie.Document.body.innertext
Set RegMatch = RegEx.Execute(MyStr)

'If a match to our RegExp searchstring is found then launch this page
If RegMatch.Count > 0 Then
    ie.Navigate RegMatch(0)
    Do Until ie.ReadyState = READYSTATE_COMPLETE
    Loop
         MsgBox "Loaded"
         'show internet explorer
    ie.Visible = True
    'Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Set iedoc = ie.Application.Document
    'iedoc.getElementById("divid").Value = "poS0"
    'MsgBox iedoc

    'ie.Navigate iedoc.getelementsbytagname("ol")(0).Children(0).getelementsbytagname("a")(0).href
    ie.Navigate iedoc.getelementsbyclassname("divid")("poS0").href
    Else
    MsgBox "No linkedin profile found"
End If

Set RegEx = Nothing
Set ie = Nothing

      

I looked at the source of the page on the google search page. I have a specific div id = "pos0" that is the id for the first search result. I have to force IE to go to the page with div id = "pos0". I cannot achieve this in VBA. Can someone please help me?

Thanks and regards, Ramesh

+3


source to share


2 answers


You have a couple of questions. First to access the document object its ie.Document

not ie.Application.Document

. I have updated your code to show how you can quickly find the first url using a substring.



Dim ie As InternetExplorer
Dim RegEx As RegExp, RegMatch As MatchCollection
Dim MyStr As String
Dim pDisp As Object
Set ie = New InternetExplorer
Set RegEx = New RegExp
Dim iedoc As Object

'Search google for "something"
ie.Navigate "http://www.google.com.au/search?hl=en&q=sachin+tendulkar+wiki&meta="

'Loop unitl ie page is fully loaded
Do Until ie.ReadyState = READYSTATE_COMPLETE
Loop



MyStr = ie.Document.body.innertext
Set RegMatch = RegEx.Execute(MyStr)

'If a match to our RegExp searchstring is found then launch this page
If RegMatch.Count > 0 Then
    ie.Navigate RegMatch(0)
    Do Until ie.ReadyState = READYSTATE_COMPLETE
    Loop
         MsgBox "Loaded"
         'show internet explorer
    ie.Visible = True
    'Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '****************************************
    'EDITS
    '****************************************
    Set iedoc = ie.Document

    'create a variable to hold the text
    Dim extractedHTML As String
    'start and end points for the substring
    Dim iStart, iEnd As Integer
    'get the element with ID of search - this is where the results start
    extractedHTML = iedoc.getElementById("search").innerHTML
    'find the first href as this will be the first link, add 1 to encompass the quote
    iStart = InStr(1, extractedHTML, "href=", vbTextCompare) + Len("href=") + 1
    'locate the next quote as this will be the end of the href
    iEnd = InStr(iStart, extractedHTML, Chr(34), vbTextCompare)
    'extract the text
    extractedHTML = Mid(extractedHTML, iStart, iEnd - iStart)
    'go to the URL
    ie.Navigate extractedHTML

    '****************************************
    'End EDITS
    '****************************************
    Else
    MsgBox "No linkedin profile found"
End If

Set RegEx = Nothing
Set ie = Nothing

      

+4


source


You can use the xmlHTTP object instead of using IE.
HTTP requests are simpler and much faster

Below is a sample code

Sub xmlHttp()

    Dim URl As String, lastRow As Long
    Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object


    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To lastRow

        URl = "https://www.google.co.in/search?q=" & Cells(i, 1)

        Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
        xmlHttp.Open "GET", URl, False
        xmlHttp.setRequestHeader "Content-Type", "text/xml"
        xmlHttp.send

        Set html = CreateObject("htmlfile")
        html.body.innerHTML = xmlHttp.ResponseText
        Set objResultDiv = html.getelementbyid("rso")
        Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
        Set link = objH3.getelementsbytagname("a")(0)


        str_text = Replace(link.innerHTML, "<EM>", "")
        str_text = Replace(str_text, "</EM>", "")

        Cells(i, 2) = str_text
        Cells(i, 3) = link.href
    Next
End Sub

      



enter image description here

NTN
Santos

+1


source







All Articles