时间戳

首页 > 解决方案 > VBA脚本在chrome中自动打开谷歌搜索的结果

excel - VBA脚本在chrome中自动打开谷歌搜索的结果

问题描述

我发现以下代码对我有用：

Sub SearchWindow64()
Dim chromePath As String
Dim search_string As String
Dim query As String
query = Range("A2").Value
search_string = query
search_string = Replace(search_string, " ", "+")

chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

Shell (chromePath & " -url http://google.com/#q=" & search_string)
End Sub

它打开我的谷歌浏览器并导航到谷歌并根据单元格 A2 的值进行搜索。
到目前为止一切顺利，但我也希望我的脚本打开第一个或第二个结果（这也由用户指定） - 例如，如果单元格 A3 中的值是 1 打开第一个结果，如果它是 2 - 第二个结果等等..

我为 Internet Explorer 找到了类似问题的解决方案，但我想在 Google Chrome 中执行此操作，有人可以帮忙吗？

问候，米哈伊尔

标签： excelvbagoogle-chrome

解决方案

如果您尝试使用 selenium v​​ba 路线；它仍然是使用 vba 编写的。以下不包括“人们也问”部分（以及不以“http”开头的任何内容）

Option Explicit
'Download selenium https://github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0
'Ensure latest applicable driver e.g. ChromeDriver.exe in Selenium folder
'VBE > Tools > References > Add reference to selenium type library
Public Sub Example()
    Dim d As WebDriver, ws As Worksheet, search_string As String, query As String
    Dim resultToOpen As Long, results As Object, final()
    Set d = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    query = ws.Range("A2").Value
    search_string = query
    search_string = Replace$(search_string, " ", "+")
    resultToOpen = ws.Range("A3").Value

    With d
        .Start "Chrome"
        .get "http://google.com/#q=" & search_string

        Set results = .FindElementsByCss("cite")

        final = GetUsuableLinks(results)
        If UBound(final) >= resultToOpen Then
            .get final(resultToOpen)
        Else
            'do something else
        End If

        Stop   'delete me later

        .Quit
    End With
End Sub

Public Function GetUsuableLinks(ByVal results As Object) As Variant
    Dim arr(), i As Long, j As Long, test As String
    ReDim arr(1 To results.Count)
    For i = 1 To results.Count
        test = results(i).Text
        If InStr(test, "http") > 0 Then
            j = j + 1
            arr(j) = test
        End If
    Next
    ReDim Preserve arr(1 To j)
    GetUsuableLinks = arr
End Function

推荐阅读