如何使用 Excel VBA 将值输入到网页的下拉框中

Question

我正在尝试操作一个网站，以使用 Excel VBA 宏来显示所需的期权链数据。该网站 -- CBOE.com -- 有一个输入字段，用于输入所需期权链的股票代码。我的代码已经能够驱动那部分网页，并显示默认选项链。它默认为期权到期的最近月份（截至本说明的 2018 年 5 月）。用户可以从那里输入其他到期日期，以便检索和显示其他期权链（对于同一交易品种）。这就是我的代码似乎崩溃的地方。

在默认期权链显示上方是一个标记为 "Expiration:" 的下拉输入框，您可以在其中选择其他到期月份的列表。选择后，必须单击绿色提交按钮以获取选定到期月份的指定期权链。或者，在默认期权链下方也有针对到期月份的明确筛选按钮。

如前所述，我的代码已经到了指定交易品种并显示默认期权链的地步，但我似乎无法让其他到期月份的下拉输入字段正常工作。

如果有人能看到我的代码在哪里以及如何存在缺陷，我将不胜感激。

非常感谢。 - 标记。这是我的核心代码：

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

对于您的代码：

这两行更改月份并单击视图链（我使用符号 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 URL 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 URL

        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 '<<delete me later
        .Quit
        
    End With
  
End Sub

Answer 2

如果您想坚持使用 IE，请尝试以下方法。我试图从脚本中排除硬编码延迟。它应该让你到那里。确保在执行前用下面脚本中的 appropriate ticker 填充 text field。

好了：

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

如何使用 Excel VBA 将值输入到网页的下拉框中

How to input values into dropdown box of web page using Excel VBA

excel

vba

html-select

web-scraping

drop-down-menu