Как ввести значения в выпадающий список веб-страницы с помощью Excel VBA

Question

Я пытаюсь использовать веб-сайт для отображения нужных данных цепочки опций с помощью макроса Excel VBA.Веб-сайт - CBOE.com - имеет поле ввода для символа тикера нужных цепочек опций.Мой код смог управлять этой частью веб-страницы, и отображается цепочка опций по умолчанию.По умолчанию это самый последний месяц, в котором истекает срок действия опционов (май 2018 на момент написания этой заметки).Оттуда пользователь может ввести другие даты истечения срока действия, для которых должны быть получены и отображены другие цепочки опций (для того же символа).Вот где мой код, похоже, ломается.

Чуть выше отображения цепочки опций по умолчанию находится раскрывающееся поле ввода с надписью «Истечение срока действия», в котором можно выбрать список других месяцев истечения срока действия.После выбора необходимо нажать зеленую кнопку «Отправить», чтобы получить указанную цепочку опций для выбранного месяца истечения срока действия.В качестве альтернативы, под цепочкой опций по умолчанию находятся явные кнопки фильтра и для месяцев истечения срока действия.

Как уже говорилось, мой код доходит до того, что задает символ и отображает цепочки опций по умолчанию, но я не могу получитьраскрывающееся поле ввода для других месяцев истечения срока действия.

Если кто-нибудь увидит, где и как мой код имеет недостатки, я действительно ценю это понимание.

Большое спасибо.--Отметка.Вот мой основной код в вопросе:

Sub getmarketdata_V3()

Dim mybrowser As Object, myhtml As String
Dim htmltables As Object, htmltable As Object
Dim htmlrows As Object, htmlrow As Object
Dim htmlcells As Object, htmlcell As Object
Dim xlrow As Long, xlcol As Integer
Dim exitat As Date, symbol As String
Dim flag As Integer

On Error GoTo errhdl

Const myurl = "http://www.cboe.com/delayedquote/quote-table"

symbol = UCase(Trim(Range("ticker").Text))

With Range("ticker").Worksheet
    Range(Range("ticker").Offset(1, 0), Cells(Rows.Count, Range("ticker").Column + 13)).ClearContents
End With

Set mybrowser = CreateObject("internetexplorer.application")

mybrowser.Visible = True

mybrowser.navigate myurl

While mybrowser.busy Or mybrowser.readyState <> 4
    DoEvents
Wend

With mybrowser.document.all

    exitat = Now + TimeValue("00:00:05")
    Do
        .Item("ctl00$ContentTop$C002$txtSymbol").Value = symbol
        .Item("ctl00$ContentTop$C002$btnSubmit").Value = "Submit"
        .Item("ctl00$ContentTop$C002$btnSubmit").Click
        If Err.Number = 0 Then Exit Do
        Err.Clear
        DoEvents
        If Now > exitat Then Exit Do
    Loop
End With

'This With statement is to refresh the mybrowser.document since the prior With statement pulls up a partially new webpage
With mybrowser.document.all
    On Error Resume Next
    exitat = Now + TimeValue("00:00:05")

'Tried using "ID" label to select desired month--in this case 2018 July is a dropdown option:
'Usind this label seems to blank out the value displayed in the dropdown input box, but does not cause
'any of the options to display nor implant "2018 July" in it either. It just remains blank and no new option
'chain is retrieved.
    .Item("ContentTop_C002_ddlMonth").Select
    .Item("ContentTop_C002_ddlMonth").Value = "2018 July"
    .Item("ContentTop_C002_ddlMonth").Click

'Then tried using "Name" label to select desired month--in this case 2018 July is an option:

  '  .Item("ctl00$ContentTop$C002$ddlMonth").Value = "2018 July"
  '  .Item("ctl00$ContentTop$C002$ddlMonth").Click

  '  .Item("ctl00$ContentTop$C002$btnFilter").Value = "View Chain"

  '  .Item("ctl00$ContentTop$C002$btnFilter").Click


    End With

While mybrowser.busy Or mybrowser.readyState <> 4
    DoEvents
Wend

'Remaining logic, except for this error trap logic deals with the option chain results once it has been successfully retrieved.
'For purposes of focus on the issue of not being able to successfully have such a table displayed, that remaining process logic is not
'included here.


errhdl:
If Err.Number Then MsgBox Err.Description, vbCritical, "Get data"
On Error Resume Next
mybrowser.Quit
Set mybrowser = Nothing
Set htmltables = Nothing

End Sub

Answer 1

Попробуйте следующий подход, если хотите придерживаться IE.Я пытался выкинуть запрограммированную задержку из сценария.Это должно привести вас туда.Обязательно заполните text field с помощью appropriate ticker из приведенного ниже сценария перед выполнением.

Итак, вы идете:

Sub HandleDropDown()
    Const url As String = "http://www.cboe.com/delayedquote/quote-table"
    Dim IE As New InternetExplorer, Html As HTMLDocument, post As Object, elem As Object

    With IE
        .Visible = True
        .navigate url
        While .Busy Or .readyState <> 4: DoEvents: Wend
        Set Html = .document
    End With

    Do: Set post = Html.getElementById("ContentTop_C002_txtSymbol"): DoEvents: Loop While post Is Nothing
    post.Value = "tickername"  ''make sure to fill in this box with appropriate symbol

    Html.getElementById("ContentTop_C002_btnSubmit").Click

    Do: Set elem = Html.getElementById("ContentTop_C002_ddlMonth"): DoEvents: Loop While elem Is Nothing
    elem.selectedIndex = 2 ''just select the month using it's dropdown order

    Html.getElementById("ContentTop_C002_btnFilter").Click
End Sub

Ссылка для добавления в библиотеку:

Microsoft Internet Controls
Microsoft HTML Object Library

Answer 2

Для вашего кода:

Эти 2 строки изменяют месяц и щелкают по цепочке просмотра (я тестировал с символом FLWS).Убедитесь, что у вас достаточно задержек, чтобы страница действительно загрузилась.

mybrowser.document.querySelector("#ContentTop_C002_ddlMonth").Value = "201809"
mybrowser.document.querySelector("#ContentTop_C002_btnFilter").Click

---

При добавлении в ваш код я нашел приведенный выше фрагмент времени, поэтому у меня была быстрая игра с Selenium basic .Вот пример с селеном:

Option Explicit
'Tools > references > selenium type library 

Public Sub GetMarketData()

    Const MYURL As String = "http://www.cboe.com/delayedquote/quote-table"
    Dim d As ChromeDriver, symbol As String
    symbol = "FLWS"
    Set d = New ChromeDriver

    With d
        .Start
        .Get MYURL

        Dim b As Object, c As Object, keys As New keys
        Set b = .FindElementById("ContentTop_C002_txtSymbol")
        b.SendKeys symbol
        .FindElementById("ContentTop_C002_btnSubmit").Click
        Set c = .FindElementById("ContentTop_C002_ddlMonth")
        c.Click
        c.SendKeys keys.Down                     'move one month down
        .FindElementById("ContentTop_C002_btnFilter").Click

        Stop
        .Quit

    End With

End Sub