Excel 从web插入数据时选择下拉列表（VBA）_Excel_Vba_Web Scraping

Excel 从web插入数据时选择下拉列表（VBA）

excel vba web-scraping

Excel 从web插入数据时选择下拉列表（VBA）,excel,vba,web-scraping,Excel,Vba,Web Scraping,我想从网页（）下载一些数据到Excel电子表格中加载此页面后，我必须从“Código do Ativo”下拉列表中手动选择一个选项，然后选择“议程” 有没有一种方法可以通过VBA自动完成例如：从“Código do Ativo”下拉列表中选择“RDVT11”，选择“议程”，然后从页面底部的表格中下载数据到目前为止，我的宏： Private Sub Agenda() Sheets("Dados").Select Dim ProductionAddress As String Product

我想从网页（）下载一些数据到Excel电子表格中

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

有没有一种方法可以通过VBA自动完成

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

到目前为止，我的宏：

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

Private子议程（）
图纸（“护墙板”）。选择
Dim ProductionAddress作为字符串
生产地址=”http://www.debentures.com.br/exploreosnd/consultaadados/sndemumclique/x_pu_historico_r.aspx?"
模糊的物体
设置ie=CreateObject（“InternetExplorer.Application”）
与ie
.Silent=True
.Visible=True
.导航生产地址
以
当ie.ReadyState 4或ie.Busy:DoEvents:Wend
ie.document.getElementByid（“ctl00_ddlAti”）.Value=“RDVT11 | 1100111011110001”
当ie.ReadyState 4或ie.Busy:DoEvents:Wend
设置objButton=ie.document.getElementByid（“ctl00\u x\u议程”）
对焦
对象按钮。单击
当ie.ReadyState 4或ie.Busy:DoEvents:Wend
即退出
设置ie=无
端接头

您需要捕获激活下拉列表时浏览器发送的请求。打开Chrome开发工具并查看网络选项卡。您将看到对

sndemumclique/

的POST请求。这将有一些标题和表单数据。您的代码基本上需要复制此请求。很可能，并非所有的标题和表单字段都是必需的，但如果不尝试，就无法知道答案。

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

注意事项：

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

① 做出第一选择：

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

要进行

RDVT11

选择，我首先使用下拉列表中的

Id

捕获变量中的元素，包括：

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

接下来，我循环下拉选项，使用

a.getElementsByTagName（“选项”）

生成我循环的集合。找到目标选择文本后，我将该选项设置为

Selected

，并退出循环

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

② 进行议程选择：

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

然后，我通过其

id

定位

Sobre e emissão

的

agenda

选项，然后单击

并等待页面刷新：
.document.getElementById("ctl00_x_agenda_r").Click
While .Busy Or .readyState < 4: DoEvents: Wend

最后，我循环表中的行和列，将其写入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

选项显式
公共子MakeSelectiongGetData（）
Dim IE成为新的InternetExplorer
常量URL=”http://www.debentures.com.br/exploreosnd/consultaadados/sndemumclique/"
常量optionText为String=“RDVT11”
Application.ScreenUpdating=False
与IE
.Visible=True
.浏览网址
当.Busy或.readyState<4:DoEvents:Wend时
使物体变暗
设置a=.document.getElementById（“ctl00_ddlAti”）
将当前选项设置为对象
对于a.getElementsByTagName（“选项”）中的每个currentOption
如果InStr（currentOption.innerText，optionText）>0，则
currentOption.Selected=True
退出
如果结束
下一个当前选项
.document.getElementById（“ctl00\u x\u议程”）。单击
当.Busy或.readyState<4:DoEvents:Wend时
暗表为HTMLTable
Do:On Error Resume Next:Set nTable=.document.getElementById（“议程”）：On Error转到0:DoEvents:Loop，而nTable为Nothing
变暗nRow为对象，nCell为对象，r为长，c为长
使用ActiveSheet
作为物体的物体
Set nBody=nTable.getElementsByTagName（“tbody”）（0.getElementsByTagName（“tr”）
.Cells（1，1）=nBody（0）.内部文本
对于r=2至N车身，长度为-1
设置nRow=n车身（r）
对于nRow.单元格中的每个nCell
c=c+1:.单元格（r+1，c）=nCell.innerText
下一个nCell
c=0
下一个r
以
退出
以
Application.ScreenUpdating=True
端接头


页面上的数据（示例）


代码输出（示例）：
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

我在问题中添加了一些代码。。。如果你能看一看，我会非常感激…我把它加载到“Código do Ativo”，然后点击“议程”。我现在唯一缺少的是：如何将页面底部表格中的数据下载到电子表格中？格里沙，你能帮帮我吗？谢谢！到目前为止，我发布了我的代码。它进入页面。插入“Código do Ativo”并单击“议程”。现在我无法将表格下载到电子表格中（表格名为“ctl00\u ContentPlaceHolder1\u C\u agenda\u r1\u grdAgenda”），你能帮我吗？