VBA скрипт для автоматического открытия результатов поиска Google в Chrome

Question

Я нашел следующий код, который работает для меня:

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, кто-нибудь может помочь с этим?

С уважением, Михаил

Answer 1

Если вы попробуете селен 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