2015-08-17 2 views
0

Я использую следующий код для сбора первого URL-адреса из поиска Google. Есть ли способ редактировать код, чтобы он собирал только текст, расположенный сразу после зеленого URL-адреса в результатах поиска Google?конкретная информация из результата поиска Google

Каждый результат поиска содержит 4 строки информации:

header 
URL in green 
text1 
text2 

Я хочу, чтобы собрать одну строку текста, которая появляется после зеленого URL.

Возможно ли это?

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 
On Error Resume Next 
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 

ответ

1

Он смотрит на меня, как текст в <span class="st">, так что это должно сделать трюк:

Dim HTML 
Set HTML = CreateObject("htmlfile") 
HTML.body.innerHTML = XMLHTTP.ResponseText 

Dim e 
For Each e In HTML.getElementsByTagName("span") 
    If e.className = "st" Then 
     Debug.Print e.innerText 
     Exit For 
    End If 
Next 

Редактировать Показаны полный сценарий:

Dim XMLHTTP 
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP") 
XMLHTTP.Open "GET", "https://www.google.co.in/search?q=test", 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 

Dim HTML 
Set HTML = CreateObject("htmlfile") 
HTML.body.innerHTML = XMLHTTP.ResponseText 

Dim e 
For Each e In HTML.getElementsByTagName("span") 
    If e.className = "st" Then 
     Debug.Print e.innerText 
     Exit For 
    End If 
Next 

Выход

Test your Internet connection bandwidth to locations around the world with this interactive broadband speed test from Ookla. 
+0

Он работает для вас, ничего не происходит, когда я запускаю код –

+0

Да. Это было для меня. Я скопировал его непосредственно из рабочего скрипта. – Bond

+0

странно. он не работает здесь, не могли бы вы рассказать код, который вы использовали. –

Смежные вопросы