Использование VBA в Excel в Google Search в IE и возврат гиперссылки первого результата

Question

Я пытаюсь использовать автоматизацию IE для поиска в Google строки текста в Excel. Я хочу вернуть гиперссылку на сайт первого результата в другой ячейке в excel. Это возможно? У меня есть список из 60 000 записей, которые мне нужны для поиска в Google, и верните гиперссылку для веб-сайта в первый результат. Есть ли другой подход к этому, который вы бы рекомендовали? Я ценю помощь заранее.

Answer 1

Как его 60 000 записей, я рекомендую использовать объект xmlHTTP вместо использования IE.
HTTP запрашивает проще, и намного быстрее

Загрузить образец файла here

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 
    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")(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 
     DoEvents 
    Next 

    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 

НТН
SANTOSH

Answer 2

Ссылки, по-видимому, постоянно находятся внутри тегов H3. Как правило, вы можете использовать что-то вроде следующего, чтобы проверить, пока не будет загружена страница:

Private Declare Sub Sleep Lib "kernel32" (ByVal nMilliseconds As Long) 

Sub UseIE() 
    Dim ie As Object 
    Dim thePage As Object 
    Dim strTextOfPage As String 

    Set ie = CreateObject("InternetExplorer.Application") 
    'ie.FullScreen = True 
    With ie 
     '.Visible = True 
     .Navigate "http://www.bbc.co.uk" 
     While Not .ReadyState = READYSTATE_COMPLETE '4 
      Sleep 500  'wait 1/2 sec before trying again 
     Wend 
    End With 

    Set thePage = ie.Document 
    'more code here 
End Sub 

Однако, я бы, вместо этого, несколько раз пытаются ссылаться на элемент в первом Н3 с помощью getElementsByTagName("H3"), получить первый из этих элементов , затем посмотрите на это для A-link и его атрибута href.

В JavaScript попытки ссылаться на несуществующие элементы возвращают undefined, но из VBA ему, вероятно, понадобится код обработки ошибок.

После того как я получен HREF Я бы остановить навигацию (не уверен, что команды для этого, вероятно, ie.Stop) или перейти к следующей странице сразу.

Первыми ссылками, однако, часто являются спонсируемые ссылки, а возвращаемый href немного искажен. Текст этих спонсируемых ссылок включает в себя теги em. Я могу использовать эту информацию, чтобы отбросить эти ссылки и посмотреть дальше по странице.

Я не знаю, есть ли лучший способ сделать это.