Follow Hyperlink VBA Webscraping

[excely]

Hi guys,

I'm trying to automate through vba a script that will follow a list of hyperlinks to Google search results and to copy the phone number listed for each link (phone numbers in google searches are listed on the right hand side).

Example link showing the phone number on the right hand side for Best Buy is below in the code.

I am unable to figure out how to reference the open browser and webscrape for the phone number to paste into a specific cell. Any help would be appreciated.

Thanks!

Some of the code:

Sub data()
Dim i As Integer
i = 2         

 ActiveWorkbook.FollowHyperlink Address:="https://www.google.ca/search?rlz=1C1GCEA_enCA793CA793&ei=tXMBXPmPLYXljwSx_qyABQ&q=bestbuy&oq=bestbuy&gs_l=psy-ab.3..0i131i67j0i131l2j0i67l2j0i10j0i67j0j0i67l2.14142.14860..15021...0.0..0.94.544.7......0....1..gws-wiz.......0i71.JDd44WmjBlY"     

With CreateObject("Shell.Application").Windows
Set IE = .Item(0) ' or .Item(.Count - 1)
End With         

IE.Document.getElementsByClassName("Z1hOCe").Copy

      ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("a1")         
   
 End Sub

 

[Domenic]

I would suggest that you instead simply create an instance of Internet Explorer, and then use it to navigate to the desired site. Also, getElementsByClassName returns a collection of elements, where the elements are indexed starting at 0. So , let's assume that you want the first element from the collection, maybe something like this...

    Dim internetExplorer As Object
    Dim htmlDoc As Object
    
    Set internetExplorer = CreateObject("InternetExplorer.Application")
    
    With internetExplorer
        .Visible = True
        .navigate "Enter your URL address here"
        Do While .busy Or .readystate <> 4 'READYSTATE_COMPLETE
            DoEvents
        Loop
        Set htmlDoc = .document
    End With
    
    Worksheets("Sheet1").Range("a1").Value = htmlDoc.getElementsByClassName("Z1hOCe")(0).innerText

 

[excely]

Hi Domenic,

Thanks for replying. The code you provided does what I am looking for and I did think of doing that. However, I would like to automate through a list of URL addresses (google searches) and unfortunately .navigate does not allow you to do something like this:

For Each id In ThisWorkbook.Sheets("Sheet1").Range("B1:B" & lastrow)
ActiveWorkbook.FollowHyperlink Address:="[URL]http://www.google.com/search?q[/URL]=" & id

Is there anything you can suggest that would get this result?



Thanks

 

[Domenic]

I haven't tested it, but maybe something like this...

Option Explicit

Sub test()


    Dim internetExplorer As Object
    Dim htmlDoc As Object
    Dim htmlElement As Object
    Dim idRange As Range
    Dim idCell As Range
    Dim id As String
    Dim lastRow As Long
    
    With ThisWorkbook.Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set idRange = .Range("B1:B" & lastRow)
    End With
    
    Set internetExplorer = CreateObject("InternetExplorer.Application")
    
    With internetExplorer
        .Visible = True
        For Each idCell In idRange
            id = idCell.Value
            .navigate "http://www.google.com/search?q=" & id
            Do While .busy Or .readystate <> 4 'READYSTATE_COMPLETE
                DoEvents
            Loop
            Set htmlDoc = .document
            Set htmlElement = htmlDoc.getElementsByClassName("Z1hOCe")(0)
            If htmlElement Is Nothing Then
                idCell.Offset(, -1).Value = "N/A"
            Else
                idCell.Offset(, -1).Value = htmlDoc.getElementsByClassName("Z1hOCe")(0).innerText
            End If
        Next idCell
    End With
    
End Sub

 

[excely]

Almost works perfectly. The only issue is that it pulls the address instead of the phone number. I changed the code from (0) to (2) which works for most of the searches. However, some numbers get pulled on (3). Any ideas to get all the different ones? Thanks

  Set htmlElement = htmlDoc.getElementsByClassName("Z1hOCe")(2)
  Set htmlElement = htmlDoc.getElementsByClassName("Z1hOCe")(3)

 

[Domenic]

I think you'll need to provide the actual URLs. However, since I don't know when I'll be available to help, I would suggest that you start a new thread, provide some examples of URLs, and explain which information you're looking for. Someone will likely be able to provide you with the help you need.

 

[excely]

I decided to change the elementclass () so the code retrieves the entire block of text/information and I can create a function to pull the phone numbers from the cells.

Set htmlElement = htmlDoc.getElementsByClassName("ifM9O")(0)

Thanks for your help.