我找到了一些 VBA excel 代码,可以在 google 上查找关键字范围并返回第一个链接。我想在开头添加一个输入框来表示获取前 5 个链接。我有 2000 个关键词,我需要在谷歌上搜索并返回前几个链接。有人可以帮我扩展此代码以做到这一点吗????太感谢了!
这是另一个stackoverflow用户提供的代码:
子 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 是下一个 ....etc。此外,如果我的列表中有带有“hello”的 A1 和带有“hawaii”的 A2,那么在 5 个新名称和链接之后,我的 A2 单元格将被下推到 A6。
提前感谢大家的帮助。你真的会救我的!
最佳答案
你问了很多不同的问题,但要回答我认为的主要问题,这一行:
Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
是什么控制代码正在查看的链接。因此,通过将 0 更改为 1,它现在将处理第二个链接。通过编写一个简单的 for 循环,您可以处理前五个链接。我建议首先重新格式化您的数据以留出足够的空间来填写五个条目,然后使用简单的 for 循环方法,例如 which 确实有效,但可能需要一段时间才能使用 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 谷歌查找,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/24829482/