Consulting

Results 1 to 2 of 2

Thread: Need first Google search result for 900 cells

  1. #1

    Question Need first Google search result for 900 cells

    Hello! I have a list of 900 company names that I need to google to get their website. Usually when I search for the company name the first search result is their website. I tried using the UDF below but when I enter the formula and select the cell I get #VALUE!. I've tried manually typing it in, making sure the cells are formatted as Text, but it still doesn't work. What could be the problem here?


    I also tried using the macro below but I don't know how to modify it for Chrome instead of IE. Also, I tried running it and it always crashes excel, I also got the error about "objH3" not being defined.


    TIA!



    The UDF code I'm using:



    Option Explicit


    Function GoogleFirstUrl(search As String) As String


    Dim i As Long
    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


    Dim cookie As String
    Dim result_cookie As String


    DoEvents
    url = "https://www.google.co.in/search?q=" & search & "&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 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/75.0.3770.90 Safari/537.36"
    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)


    GoogleFirstUrl = link.href


    End Function





    The macro I tried:



    Sub XMLHTTP()


    Dim url As String, lastRow As Long, i As Long
    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
    Dim start_time As Date
    Dim end_time As Date


    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 = 2 To lastRow


    url = "https://www.google.co.in/search?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")


    Set objH3 = objResultDiv.getelementsbytagname("h3")




    For Each link In objH3


    If link.className = "r" Then


    Cells(i, 2) = link.innerText
    Cells(i, 3) = link.getelementsbytagname("a")(0).href
    DoEvents
    End If
    Next
    Next


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


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

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Welcome to the forum! Please paste code between code tags. Click the # icon on the reply toolbar to insert the tags.

    You will need to get one run to work before trying something else. The return errors but you can see the response text in the Immediate window after running the test sub. Manually viewing the source code for the website might show you if you have the element IDs set.

    Sub Test_GoogleFirstUrl()  
      MsgBox GoogleFirstUrl("Google")
    End Sub
    
    
    Function GoogleFirstUrl(search As String) As String
      Dim i As Long, url As String, lastRow As Long
      'Tools > References > Microsoft XML, v6.0
      Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
      Dim cookie As String, result_cookie As String
      
      lastRow = Range("A" & Rows.Count).End(xlUp).Row
      
      DoEvents
      'url = "https://www.google.co.in/search?q=" & search & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
      url = "https://www.google.co.in/search?q=" & search & "&rnd=1"
      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 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) " & _
        "Chrome/75.0.3770.90 Safari/537.36"
      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)
      
      'GoogleFirstUrl = link.
      Debug.Print XMLHTTP.ResponseText
    End Function
    
    
    
    
    Sub XMLHTTP()
      Dim url As String, lastRow As Long, i As Long
      Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
      Dim start_time As Date, end_time As Date, cookie As String, result_cookie As String
      
      lastRow = Range("A" & Rows.Count).End(xlUp).Row
      
      start_time = Time
      Debug.Print "start_time:" & start_time
      
      For i = 2 To lastRow
        url = "https://www.google.co.in/search?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")
        Set objH3 = objResultDiv.getelementsbytagname("h3")
        For Each link In objH3
          If link.className = "r" Then
            Cells(i, 2) = link.innerText
            Cells(i, 3) = link.getelementsbytagname("a")(0).href
            DoEvents
          End If
        Next link
      Next i
      
      end_time = Time
      Debug.Print "end_time:" & end_time
      Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time) & " :minutes"
      MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •