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

Question

我正在使用 vba 并尝试填写此网站中的表格并在此处获取输出链接

当我尝试填写从/到机场的输入框时出现问题。这是我尝试过的：正在调用此函数来填写往返机场字段

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

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

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

标签： excelvbadomweb-scrapinghtml-table

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