Как я могу выбрать вариант из этого выпадающего меню на этом сайте - PullRequest
Новая
       13

Как я могу выбрать вариант из этого выпадающего меню на этом сайте

1 голос
/ 18 марта 2019

Я работаю в 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 в качестве ввода.

Есть 2 варианта для аэропорта прибытия (TO): HEL и SIN, он как-то нажал HEL. Тем не менее, если я делаю это наоборот, то есть: от SIN до HKG, нет проблем с выбором SIN с 10+ опциями. Как я могу решить это? Любая помощь будет оценена.

1 Ответ

0 голосов
/ 19 марта 2019

Следующее использует регулярное выражение для поиска предложенного списка для правильной записи, а затем нажмите. Я хотел бы исключить некоторые из предположительно коротких жестко заданных задержек, но пока не нашел надежного способа обеспечения полного заполнения раскрывающегося списка, учитывая, что он постоянно заполняется из вызовов 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
...