Создать новую вкладку для каждого поиска Google по селену в Excel VBA - PullRequest
0 голосов
/ 19 ноября 2018

Я пытаюсь выполнить поиск Google на основе некоторых данных в столбце A на Листе 1 ... и мне нужно, чтобы содержимое каждой ячейки открывалось в новой вкладке, и я выполняю поиск для этого примера ячейки: в A1 есть слово «цветок», поэтомуЯ ожидаю создать вкладку и перейти в Google, чтобы выполнить поиск для этого «цветка», затем в следующую ячейку и т. Д., И каждый поиск будет в новой вкладке. Вот моя попытка

Sub Test()
Dim bot         As New ChromeDriver
Dim Keys        As New Keys

bot.Get "https://www.google.com"
'search for items in column A

bot.ExecuteScript "window.open(arguments[0])", "https://www.google.com"
bot.SwitchToNextWindow
End Sub

Я также пыталсяэта часть

bot.FindElementById("gsr").SendKeys Range("A1").Value
bot.SendKeys bot.Keys.Enter
bot.SwitchToNextWindow

Но я не смог создать новую вкладку

1 Ответ

0 голосов
/ 19 ноября 2018

Попробуйте следующее. Вам нужно настроить поле поиска для ввода текста.

Option Explicit
Public Sub Test()
    Dim bot As ChromeDriver, keys As New keys, arr(), ws As Worksheet, i As Long
    Set bot = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet1") '<==Adjust to your sheet
    arr = Application.Transpose(ws.Range("A1:A3")) '<== Adjust to your range

    With bot
        .Start "Chrome"
        .get "https://google.com/"
        For i = LBound(arr) To UBound(arr)
            If Not IsEmpty(arr(i)) Then
                If i > 1 Then
                    .ExecuteScript "window.open(arguments[0])", "https://google.com/"
                    .SwitchToNextWindow
                End If
                .FindElementByCss("[title=Search]").SendKeys arr(i)
            End If
        Next
    End With
    Stop '<==Delete me later
End Sub

Использование временного цикла для поиска элемента:

Option Explicit
Public Sub Test()
    Dim bot As ChromeDriver, keys As New keys, arr(), ws As Worksheet, i As Long
    Const MAX_WAIT_SEC As Long = 5
    Dim ele As Object, t As Date
    Set bot = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet1")   '<==Adjust to your sheet
    arr = Application.Transpose(ws.Range("A1:A3")) '<== Adjust to your range

    With bot
        .Start "Chrome"
        .get "https://google.com/"
        For i = LBound(arr) To UBound(arr)
            If Not IsEmpty(arr(i)) Then
                If i > 1 Then
                    .ExecuteScript "window.open(arguments[0])", "https://google.com/"
                    .SwitchToNextWindow
                End If
                t = Timer
                Do
                    DoEvents
                    On Error Resume Next
                    Set ele = .FindElementByCss("[title=Search]")
                    On Error GoTo 0
                    If Timer - t > MAX_WAIT_SEC Then Exit Do
                Loop While ele Is Nothing

                If Not ele Is Nothing Then
                    ele.SendKeys arr(i)
                Else
                    Exit Sub
                End If
            End If
        Next
    End With
    Stop                                         '<==Delete me later
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...