Почему SendKey Enter не работает с браузером Chrome - PullRequest
0 голосов
/ 15 января 2019

Я пытаюсь проверить несколько vins, введенных в excel, в браузере chrome, этот код откроет браузер и введет их, но при нажатии кнопки не будет нажата кнопка ввода. Не уверен, что я делаю не так, но я попробовал несколько вариантов и, похоже, ничего не могу придумать.

Извините, если мое форматирование ужасно, я впервые публикую здесь.

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

StartRow = 2
EndRow = InputBox("Please enter how many vins to check!")

RowIndex = 2
EndRow = 1 + EndRow

For i = StartRow To EndRow
Vin = Sheets("VinCheck").Cells(i, "A")
browser = Shell(chromePath & " -url https://www.autoreturn.com/indianapolis-in/find-vehicle/ ")

Application.Wait Now + 0.00003



Application.SendKeys "{Tab}", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Tab}", True

Application.SendKeys Vin, True
Application.SendKeys "{~}", True

Application.SendKeys "{Tab}", True 
Application.Wait Now + 0.00003


Msg = "Was Vehicle Found?" & vbCrLf & "Click Yes to move on to the next Vin"
MsgBox Msg, vbYesNo, "Advanced Excel Training"
If Response = vnYes Then
Sheets("VinCheck").Cells(i, "B").Value = "Found"
Else
Sheets("VinCheck").Cells(i, "B").Value = "Vehicle Not Found"
End If
Next i
End Sub

1 Ответ

0 голосов
/ 15 января 2019

Я бы дал selenium basic wrapper для vba попробовать, если вам разрешено установить. После установки вы добавляете ссылку на библиотеку типов селена через vbe> инструмент> ссылки. Вам нужна последняя версия Chrome для установки и chromedriver, а файл chromedriver.exe должен находиться в той же папке, что и исполняемые файлы Selen.

Тогда синтаксис вашей задачи будет приятным и описательным. Я не добавил петлю для vins, но показаны основные элементы для поиска. Я предоставляю подпрограмму для записи результатов на лист.

Я хотел бы иметь возможность убрать явное ожидание после SendKeys, но, по-видимому, нет событий / изменений страницы, которые я могу отслеживать, чтобы определить, когда нажимать кнопку и включить отправленный vin. Ожидание в 1 секунду кажется достаточным. Вы можете уменьшить это в зависимости от того, сколько поисков вы выполняете.

Option Explicit
Public Sub SearchVins()
    Dim d As WebDriver, hTable As Object, ws As Worksheet, t As Date
    Dim headers(), vin As String
    Const MAX_WAIT_SEC As Long = 10
    Set d = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Const URL = "https://www.autoreturn.com/indianapolis-in/find-vehicle/"

    headers = Array("License", "State", "Make", "Model", "Color", "Vin", "Status", "Tow date and Time")
    vin = "1G4HD57287U218052"

    With d
        .Start "Chrome"
        .get URL

        .FindElementById("vin").SendKeys vin     '<== vin

        Application.Wait Now + TimeSerial(0, 0, 1)

        .FindElementByCss("[onclick='submitVin()']").Click

        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set hTable = .FindElementByCss("table")  'use tag name of results table to target table
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While hTable Is Nothing
        'do something with results
        If Not hTable Is Nothing Then
            WriteTable hTable, LastRow(ws) + 2, ws
            Set hTable = Nothing
        End If

        .FindElementByCss("a.more-link").Click   '<== search again button
        'Another search for example.....
        Stop                                     '<==Delete me later
        ws.Cells(2, 2).Resize(1, UBound(headers) + 1) = headers '<== Finally add headers
        .Quit
    End With
End Sub

Public Sub WriteTable(ByVal hTable As Object, ByVal startRow As Long, ByVal ws As Worksheet)
    Dim tr As Object, td As Object, r As Long, c As Long
    r = startRow
    For Each tr In hTable.FindElementsByTag("tr")
        c = 1
        For Each td In tr.FindElementsByTag("td")
            ws.Cells(r, c) = td.Text
            c = c + 1
        Next
        r = r + 1
    Next
End Sub
Public Function LastRow(ByVal sh As Worksheet) As Long
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...