VBA EXCEL GOOGLE LOOKUP [英] VBA EXCEL GOOGLE LOOKUP

问题描述

我发现了一些VBA excel代码，允许在google上查找关键词的范围，并返回第一个链接。我想在开头添加一个输入框，以获得前5个链接。我有2000个关键词，我需要在谷歌搜索并返回顶部的几个链接。有人可以帮我扩大这个代码，以做到这一点吗？非常感谢！

I found some VBA excel code that allowed the range of key words to be looked up on google and returned the first link. I want to add an input box in the beginning to say get the top 5 links. I have 2000 key words that i need to search on google and return the top few links. Can someone please help me expand this code in order to do that???? Thank you so much!

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

Here is the code provided by another stackoverflow user:

Sub XMLHTTP（）

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和夏威夷，那么我的A2单元格将在5个新的名字和链接之后被推下A6。

Column A was the keywords, Column B was the link Name, C was the link. I want to keep that format but add a few more lined between each keyword. Meaning that if A1 has the keyword "hello" then B1 would be first link name and C1 is link. B2 would be next link name and C2 next link, B3 next ....etc. Also if my list has A1 with "hello" and A2 with "hawaii" then my A2 cell would be pushed down to A6 after the 5 new names and links.

谢谢你们都提前为你提供帮助。你真的会拯救我！

Thank you all for your help in advance. You would really be saving me!

推荐答案

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

You asked a lot of different questions but to answer what I perceive as the main problem, this line:

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

是什么控制代码所在的链接。所以通过将0更改为1，它将处理第二个链接。通过编写一个简单的循环，您可以处理前五个链接。我建议先重新格式化您的数据，留下足够的空间填写五个条目，然后使用一个简单的循环方法，如哪些工作，但可能需要一段时间的1000个术语（我也把它从A1开始，如你所说）：

is what controls what link the code is looking at. So by changing the 0 to 1 it will now process the second link. By writing a simple for loop you can process the top five links. I would suggest reformatting your data first to leave enough spaces to fill in with the five entries and then use a simple for loop approach such as which does work but may take awhile for 1000 terms (also I switched it to start at A1 like you said):

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！