VBA脚本可自动在chrome浏览器中打开来自Google搜索的结果

时间:2019-04-16 20:41:31

标签: excel vba google-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

它会打开我的Google Chrome浏览器并导航到google,然后根据单元格A2的值进行搜索。
到目前为止,还不错,但是我也希望脚本打开第一个或第二个结果(用户也可以指定该结果)-例如,如果单元格A3中的值为1,则打开第一个结果,如果其值为2 -第二个结果,依此类推。

我已经找到了针对Internet Explorer类似问题的解决方案,但是我想在Google Chrome中做到这一点,有人可以帮忙吗?

关于, Mihail

1 个答案:

答案 0 :(得分:0)

如果您尝试硒vba路线;仍然使用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