Excel vba 在单元格中提取前 5 个谷歌搜索结果 URL答案

【问题标题】：Excel vba extract top 5 google search results URL in cellExcel vba 在单元格中提取前 5 个谷歌搜索结果 URL
【发布时间】：2020-06-14 16:30:59
【问题描述】：

我有下面的 VBA 代码，它可以很好地获取第一个结果 URL，但我希望它修改以获得前 5 个结果 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

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

我没有 VBA 专业知识，但在最后一次尝试中，我尝试这样做并在所有结果中获得相同的链接

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
    Set link2 = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link2.innerHTML, "<EM>", "")
    Cells(i, 4) = link2.href
    Set link3 = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link3.innerHTML, "<EM>", "")
    Cells(i, 5) = link3.href
    Set link4 = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link4.innerHTML, "<EM>", "")
    Cells(i, 6) = link4.href

【问题讨论】：

所以你'尝试了几个小时'来编写一个循环，将 .getElementsByTagName("H3")(0) 中的 0 从 0 更改为 4？请edit您的问题包括您的最后一次尝试。
我已经更新了请看一下

标签： excel vba

【解决方案1】：

知道了。感谢 Jeeped 为我指明了正确的方向。

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) = link.href
    Set objH3 = objResultDiv.getElementsByTagName("H3")(1)
    Set link = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")
    Cells(i, 3) = link.href
    Set objH3 = objResultDiv.getElementsByTagName("H3")(2)
    Set link = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")
    Cells(i, 4) = link.href
    Set objH3 = objResultDiv.getElementsByTagName("H3")(3)
    Set link = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")
    Cells(i, 5) = link.href
    Set objH3 = objResultDiv.getElementsByTagName("H3")(4)
    Set link = objH3.getElementsByTagName("a")(0)
    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")
    Cells(i, 6) = 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

谢谢你

【讨论】：