如何从本网站的下拉菜单中选择选项

Question

我在vba工作并尝试填写本网站的表格并获得输出Link Here

当我尝试从/到机场填写输入框时出现问题。这就是我所尝试的：这个函数被调用来填充/到机场字段

Function enter_get_name(ByVal iedoc As HTMLDocument, _
                    ByVal input_box As String, ByVal iata As String, _
                    ByVal id As String, ByRef str As Variant) As Boolean
Dim noopt       As Integer       ' length of string that appear on drop down menu if no option available
noopt = Len("If your destination does not appear among the cities listed in the destination box")

iedoc.getElementsByName(input_box)(0).innerText = iata                 ' enter string
Set drop_down = iedoc.getElementById(id).getElementsByTagName("li")
Do While drop_down.Length = 0: DoEvents: Loop     ' wait for the drop down menu to come up

If Len(drop_down(0).innerText) = noopt Then  ' if option do not exist
    enter_get_name = False                             ' return value
    Exit Function                                       ' exit
Else
    For Each Name In drop_down       ' loop all options of drop down menu
        ' if found a exact same IATA code, click that html element
        str = Mid(Name.innerText, Len(Name.innerText) - 4, 3)
        If StrComp(iata, str, 1) = 0 Then
            Name.Click
        Exit For
        End If
    Next

    enter_get_name = True
End If
End Function

所以我试图循环下拉列表中的所有可用选项，找到该元素，然后单击它。代码可以成功找到元素，但是当我尝试.click该元素时，它有时不起作用。例如，我有从HKG到SIN的航班作为输入。

到达（TO）机场有2个选项：HEL和SIN，它以某种方式点击了HEL。但是，如果我反过来这样做，即：从SIN到HKG，选择SIN有10个以上选项没有问题。我该如何解决这个问题？任何帮助，将不胜感激。

Answer 1

以下使用正则表达式搜索右侧条目的建议列表，然后单击。我想淘汰一些公认的短硬编码延迟，但还没有看到确保下拉列表完全填充的可靠方法，因为它是在没有这些措施的情况下从ajax调用中不断填充的。

Public Sub GetInfo()
    Dim d As WebDriver, i As Long, t As Date
    Const MAX_WAIT_SEC As Long = 10
    Const Url = "https://applications.icao.int/icec"
    Const FROM As String = "HKG"
    Const GOING_TO  As String = "SIN"
    Dim re As Object

    Set d = New ChromeDriver
    Set re = CreateObject("vbscript.regexp")

    With d
        .Start "Chrome"
        .get Url
        .FindElementByCss("[name=frm1]").SendKeys FROM

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

        Dim fromSelection As Object
        t = Timer
        Do
            Set fromSelection = .FindElementsByCss("#ui-id-1 li")
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While fromSelection.Count = 0

        If .FindElementsByCss("#ui-id-1 li").Count = 0 Then Exit Sub

        If .FindElementsByCss("#ui-id-1 li").Count = 1 Then
            .FindElementsByCss("#ui-id-1 li").item(1).Click
        Else
            On Error Resume Next
            For i = 1 To .FindElementsByCss("#ui-id-1 li").Count
                If MatchFound(re, .FindElementsByCss("#ui-id-1 li").item(i).Text, "\(" & FROM & "[ \t]\)") Then
                    .FindElementsByCss("#ui-id-1 li").item(i).Click
                    Exit For
                End If
            Next
            On Error GoTo 0
        End If

        .FindElementByCss("[name=to1]").SendKeys GOING_TO

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

        Dim toSelection As Object
        t = Timer
        Do
            Set toSelection = .FindElementsByCss("#ui-id-2 li")
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While toSelection.Count = 0

        If .FindElementsByCss("#ui-id-2 li").Count = 0 Then Exit Sub

        If .FindElementsByCss("#ui-id-2 li").Count = 1 Then
            .FindElementsByCss("#ui-id-2 li").item(1).Click
        Else
            On Error Resume Next
            For i = 1 To .FindElementsByCss("#ui-id-2 li").Count
                If MatchFound(re, .FindElementsByCss("#ui-id-2 li").item(i).Text, "\(" & GOING_TO & "[ \t]\)") Then
                    .FindElementsByCss("#ui-id-2 li").item(i).Click
                    Exit For
                End If
            Next
            On Error GoTo 0
        End If

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

        .FindElementById("computeByInput").Click

        Stop                                     'delete me later
        .Quit
    End With
End Sub

Public Function MatchFound(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As Boolean
    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .pattern = pattern
        If .test(inputString) Then
            MatchFound = True
            Exit Function
        End If
    End With
    MatchFound = "False"
End Function