Why is SendKey Enter not working with Chrome brows

2019-07-17 08:09发布

I am trying to check several vins entered into excel in a chrome browser, this code will open the browser and enter them in but it wont hit enter to click the button. Not sure what I am doing wrong but i have tried several variations and cant seem to come up with anything.

Sorry if my formatting is terrible this is my first time posting here.

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条回答
放我归山
2楼-- · 2019-07-17 08:24

I would give selenium basic wrapper for vba a try if you are allowed to install. After installation you add a reference to selenium type library via vbe > tool > references. You need the latest chrome install and chromedriver and the chromedriver.exe should be in the same folder as the selenium executables.

Then the syntax for your task is nice and descriptive. I haven't added a loop over vins but the essential elements for the search are shown. I provide a sub to write out results to a worksheet.

I'd like to be able to remove the explicit wait after SendKeys but there doesn't appear to be any page event/change I can monitor to determine when to click the button and have the sent vin included. A 1 sec wait appears consistently to be sufficient. You could explore reducing this depending on how many searches you are performing.

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
查看更多
登录 后发表回答