在ExcelVBA中通过selenium为每次谷歌搜索创建新的选项卡



我正试图根据Sheet1中A列的一些数据进行谷歌搜索。。我需要在新选项卡中打开每个单元格内容,并搜索该单元格例如:A1有单词"花",所以我希望创建一个选项卡并导航到谷歌。搜索"花"然后搜索下一个单元格,以此类推并且每个搜索都在一个新的选项卡中这是我的

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

但我无法创建一个新的标签

尝试以下操作。您需要针对文本输入的搜索框。

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

最新更新