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有关键字＆＃34;你好＆＃34;然后B1将是第一个链接名称，C1是链接。 B2将是下一个链接名称和C2下一个链接，B3下一个....等。此外，如果我的列表中有A1＆＃34;你好＆＃34;和＃34; hawaii＆＃34;然后我的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

VBA EXCEL GOOGLE LOOKUP

1 个答案: