从 Web 插入数据时选择下拉列表 (VBA)

Question

我想从网页 (http://www.debentures.com.br/exploreosnd/consultaadados/sndemumclique/) 下载一些数据到 Excel 电子表格中。

加载此页面后，我必须从“Código do Ativo”下拉列表中手动选择一个选项，然后选择“议程”。

有没有办法通过 VBA 自动完成？

例如：从“Código do Ativo”下拉列表中选择“RDVT11”，选择“Agenda”，然后从页面底部显示的表格中下载数据？

到目前为止我的宏：

Private Sub Agenda()
Sheets("Dados").Select

Dim ProductionAddress As String
ProductionAddress = "http://www.debentures.com.br/exploreosnd/consultaadados/sndemumclique/x_pu_historico_r.aspx?"

Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
With ie
    .Silent = True
    .Visible = True
    .Navigate ProductionAddress
End With

While ie.ReadyState <> 4 Or ie.Busy: DoEvents: Wend

ie.document.getElementByid("ctl00_ddlAti").Value = "RDVT11|11001110111100001" 

 While ie.ReadyState <> 4 Or ie.Busy: DoEvents: Wend


Set objButton = ie.document.getElementByid("ctl00_x_agenda_r")
    objButton.Focus
    objButton.Click
 While ie.ReadyState <> 4 Or ie.Busy: DoEvents: Wend

ie.Quit
 Set ie = Nothing
End Sub

Answer 1

您需要捕获激活下拉菜单时浏览器发送的请求。打开 Chrome 开发工具并查看网络选项卡。您将看到对 sndemumclique/ 的 POST 请求。这将有一些标题和表单数据。您的代码将需要基本上复制此请求。可能不是所有的标题和表单字段都是必需的，但不尝试就无法知道。

Answer 2

这里是所有 3 个部分。进行两次选择并将表格写入工作表。

---

注意事项：

①首先选择：

要进行RDVT11 选择，我首先使用下拉列表的Id 来捕获变量中的元素：

Set a = .document.getElementById("ctl00_ddlAti")

接下来，我循环下拉选项，使用a.getElementsByTagName("Option") 生成我循环的集合。当找到目标选择文本时，我将该选项设置为Selected 并退出循环。

For Each currentOption In a.getElementsByTagName("Option")
    If InStr(currentOption.innerText, optionText) > 0 Then
        currentOption.Selected = True
        Exit For
    End If
Next currentOption

②进行议程选择：

然后我将Sobre e emissão 的agenda 选项通过其id 和click 定位并等待页面刷新：

.document.getElementById("ctl00_x_agenda_r").Click
While .Busy Or .readyState < 4: DoEvents: Wend

③ 获取表格并写入工作表：

然后我定位到由其id 加载的表。这是在循环中完成的，以确保表存在：

Do: On Error Resume Next: Set nTable = .document.getElementById("aGENDA"): On Error GoTo 0: DoEvents: Loop While nTable Is Nothing

我最后，循环表格中的行和列，写到Activesheet。

---

代码：

Option Explicit
Public Sub MakeSelectiongGetData()
    Dim IE As New InternetExplorer
    Const URL = "http://www.debentures.com.br/exploreosnd/consultaadados/sndemumclique/"
    Const optionText As String = "RDVT11"
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate URL

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim a As Object
        Set a = .document.getElementById("ctl00_ddlAti")

        Dim currentOption As Object
        For Each currentOption In a.getElementsByTagName("Option")
            If InStr(currentOption.innerText, optionText) > 0 Then
                currentOption.Selected = True
                Exit For
            End If
        Next currentOption
        .document.getElementById("ctl00_x_agenda_r").Click
        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim nTable As HTMLTable

        Do: On Error Resume Next: Set nTable = .document.getElementById("aGENDA"): On Error GoTo 0: DoEvents: Loop While nTable Is Nothing

        Dim nRow As Object, nCell As Object, r As Long, c As Long

        With ActiveSheet
            Dim nBody As Object
            Set nBody = nTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
            .Cells(1, 1) = nBody(0).innerText
            For r = 2 To nBody.Length - 1
                Set nRow = nBody(r)
                For Each nCell In nRow.Cells
                    c = c + 1: .Cells(r + 1, c) = nCell.innerText
                Next nCell
                c = 0
          Next r
    End With
    .Quit
End With
Application.ScreenUpdating = True
End Sub

---

页面上的数据（示例）

---

代码输出（示例）：