VBA EXCEL GOOGLE LOOKUP

Question

我找到了一些VBA excel代码，允许在谷歌上查找关键词的范围并返回第一个链接。 我想在开头添加一个输入框来说明前5个链接。 我有2000个关键词我需要在谷歌搜索并返回前几个链接。 有人可以帮我扩展这段代码，以便做到这一点???? 非常感谢！

这是另一个stackoverflow用户提供的代码：

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

列A是关键字，列B是链接名称，C是链接。 我想保留这种格式，但在每个关键字之间添加一些内容。 这意味着如果A1有关键字“hello”，那么B1将是第一个链接名称，C1是链接。 B2将是下一个链接名称和C2下一个链接，B3下一个....等。 此外，如果我的列表中的A1带有“hello”，A2带有“hawaii”，那么我的A2单元将在5个新名称和链接之后被下推到A6。

谢谢大家的帮助。 你真的会救我！

Answer 1

你问了很多不同的问题，但要回答我认为的主要问题，这一行：

Set objH3 = objResultDiv.getelementsbytagname("H3")(0)

是什么控制代码正在看什么链接。 因此，通过将0更改为1，它现在将处理第二个链接。 通过编写一个简单的for循环，您可以处理前五个链接。 我建议首先重新格式化你的数据，留下足够的空间来填写五个条目，然后使用一个简单的for循环方法，这样做可行，但可能需要一段时间1000个术语（我也把它切换到A1开始就像你说的那样）：

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
Dim Z As Long
Dim Y As Long
Z = lastRow
Y = 2
'adds the blank rows for all 5 results
While Y <= Z
    Rows(Y & ":" & Y).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Y = Y + 5
    Z = Z + 4
Wend
lastRow = (lastRow - 1) * 4 + lastRow
start_time = Time
Debug.Print "start_time:" & start_time
'starts at A1
For i = 1 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")

    'loops through the first 5 results
    For g = 0 To 4

        Set objH3 = objResultDiv.getelementsbytagname("H3")(g)
        Set link = objH3.getelementsbytagname("a")(0)


        str_text = Replace(link.innerHTML, "<EM>", "")
        str_text = Replace(str_text, "</EM>", "")

        Cells((i + g), 2) = str_text
        Cells((i + g), 3) = link.href
        DoEvents
    Next
    i = i + 4
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