Question

我正在vba中工作，尝试在此网站中填写表格并获得输出the documentation

当我尝试填写往返机场的输入框时出现问题。这就是我尝试过的方法：正在调用此函数以填写机场字段中的信息

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，选择具有10多个选项的SIN没问题。我该如何解决？任何帮助将不胜感激。

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

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

1 个答案: