【问题标题】:How to extract first Google search result URL?如何提取第一个 Google 搜索结果 URL?
【发布时间】:2019-12-15 23:52:09
【问题描述】:

我在 A 列中有大量搜索查询。 是否有任何代码可以用来提取 B 列中的第一个 Google 搜索结果 URL?

我已经成功使用了下面的代码,但它没有提取第一个搜索结果 URL,而是获取了搜索结果的数量。 任何人都可以根据我的要求帮助我更改代码吗?

Sub Gethits()
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
Dim var As String
Dim var1 As Object

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.com/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 var1 = html.getelementbyid("resultStats")
    Cells(i, 2).Value = var1.innerText

    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

【问题讨论】:

  • Pete,为了回答在 cmets 中与您交流过的人,有必要使用 @“ping”他们,例如:@Pᴇʜ - 否则会有通知 :-)
  • @PeteT 您是否查看了 TinMan 在评论中发布的链接中接受的答案?它完全符合您的要求。
  • @PeteT 我修改了 TinMan 建议的代码以满足您的需求,请尝试this

标签: excel vba google-search


【解决方案1】:

这段代码可以完成这项工作,

请注意,您需要添加 référence

工具 --> 参考资料 --> Microsoft Internet Controls

图片中:

Option Explicit
Sub tryme()

Dim ie As New InternetExplorer
Dim lastrow As Integer
Dim i As Integer

lastrow = Range("A" & Rows.Count).End(xlUp).Row


    For i = 2 To lastrow
        ie.Visible = False
        ie.navigate "https://www.google.com/search?q=" & Cells(i, 1)
        While ie.Busy Or ie.readyState < 4: DoEvents: Wend

       Cells(i, 2).Value = ie.document.querySelector("#search div.r [href*=http]").href

Next

End Sub

【讨论】:

    【解决方案2】:

    就我而言,我使用了以下代码

    Sub Demo0()
    Application.ScreenUpdating = False
        With CreateObject("InternetExplorer.Application")
            .Visible = True
        For R = 5 To Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
            .Navigate "https://www.google.co.in/search?q=" & Sheet1.Cells(R, 2).Text
            While .Busy Or .ReadyState < 4:  DoEvents:  Wend
             With .Document.querySelectorAll("#search div.r [href*=http]")
                    c = 3
                 For U = 0 To Application.Min(8, .Length - 1) Step 2
                    Sheet1.Cells(R, c) = .Item(U).href
                    c = c + 1
                 Next
             End With
        Next
            .Quit
        End With
    Application.ScreenUpdating = True
    End Sub
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2011-07-27
      • 1970-01-01
      • 2020-06-24
      • 2013-01-30
      • 1970-01-01
      相关资源
      最近更新 更多