Question

我有下面的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

Answer 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

谢谢

Excel VBA在单元格中提取前5个Google搜索结果URL

1 个答案: