VBA - 刮掉没有ID的HTML表格答案

【问题标题】：VBA - Scrape HTML table without idVBA - 刮掉没有ID的HTML表格
【发布时间】：2021-06-09 20:04:36
【问题描述】：

我正在尝试使用 VBA 从 html 表中获取数据。从列表框中选择一个值，填充一个文本框并单击一个按钮后，表格将出现。但是网站的url没有变化。

我的程序确实填满了框，选择了列表框的值并单击了“搜索”按钮，但是我无法从表中获取数据。

我需要页面末尾的表格单元格的值。 (第二个

)

这是页面的url：

代码：

Sub Info()

Dim enlace As String
Dim id As String
Dim lista
Dim rut As Integer
Dim i As Integer
Dim largo As Integer

largo = Worksheets("Lista").Cells(rows.Count, 1).End(xlUp).Row

id = Worksheets("Lista").Cells(2, 1).Value
lista = Split(id, "-")
rut = lista(0)
enlace = "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=" & rut & "&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw+cAAhAABP4MAAz&control=svs&pestania=1"

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = False
objIE.Navigate (enlace)
Do
    If objIE.ReadyState = 4 Then
        objIE.Visible = False
        Exit Do
    Else
        DoEvents
        End If
Loop

Dim button_name As String
button_name = "Aportantes"

Set link = objIE.document.getElementsByTagName("A")
For Each Hyperlink In link
If InStr(Hyperlink.innerText, button_name) > 0 Then
    Hyperlink.Click
Exit For
End If
Next

Dim nuevoLink As String
nuevoLink = Hyperlink

objIE.Quit

Set ie = CreateObject("InternetExplorer.application")
ie.Visible = False
ie.Navigate (nuevoLink)
Do
    If ie.ReadyState = 4 Then
        ie.Visible = False
        Exit Do
    Else
        DoEvents
        End If
Loop

Dim sem As String
Dim ano As Integer
sem = "03"
ano = 2018

Dim aportantes As Object
Dim cuotas_emitidas As Object

ie.document.getElementById("semestre").Value = sem
ie.document.getElementById("aa").Value = ano
Set elems = ie.document.getElementsByTagName("input")
For Each e In elems
If (e.getAttribute("value") = "Consultar") Then
    e.Click
    ''HERE IS THE PROBLEM
    Set aportantes = ie.document.getElementsByTagName("table")(1).getElementsByTagName("tr")(0).getElementsByTagName("tr")(1)
    ThisWorkbook.Worksheets("Lista").Cells(i, 4).Value = aportantes
    Set cuotas_emitidas = ie.document.getElementsByTagName("table")(1).getElementsByTagName("tr")(1).getElementsByTagName("tr")(1).innerText
    ThisWorkbook.Worksheets("Lista").Cells(i, 5).Value = cuotas_emitidas
End If
Next e
End Sub

HTML：

<table>
 <tbody>
    <tr>
    <td class="fondoOscuro">2.01.60 TOTAL APORTANTES</td>
    <td>58</td>
  </tr>

  <tr>
    <td class="fondoOscuro">2.01.70 CUOTAS EMITIDAS</td>
    <td>20000000 </td>
  </tr>
  <tr>
    <td class="fondoOscuro">2.01.71 CUOTAS PAGADAS</td>
    <td>7691000</td>

  </tr>
  <tr>
    <td class="fondoOscuro">2.01.72 CUOTAS SUSCRITAS Y NO PAGADAS</td>
    <td>0 </td>
  </tr>
  <tr>
    <td class="fondoOscuro">2.01.73 NUMERO DE CUOTAS CON PROMESA DE SUSCRIPCION Y PAGO</td>
    <td>0  </td>
  </tr>
  <tr>
    <td class="fondoOscuro">2.01.74 NUMERO DE CONTRATOS DE PROMESAS DE SUSCRIPCION Y PAGO</td>
    <td>0</td>
  </tr>
  <tr>
    <td class="fondoOscuro">2.01.75 NUMERO DE PROMITENTES SUSCRIPTORES DE CUOTAS</td>
    <td>0 </td>
  </tr>
  <tr>
    <td class="fondoOscuro">2.01.80 VALOR LIBRO DE LA CUOTA</td>
    <td>1.0059 </td>
  </tr>
</tbody></table>

【问题讨论】：

这是我的代码：
对不起，刚刚编辑完问题（我第一次问）

标签： html vba web-scraping

【解决方案1】：

XHR：

您无需打开浏览器即可使用 XHR 完成所有操作并进行抓取。将 Activesheet 输出更改为要写入表格的工作表 (WriteTable hTable, 1, ActiveSheet)。

注意 POST 正文的参数包括：

mm=12 # 个月
aa=2017 年
车辙=9278车辙代码

代码：

Public Sub GetTable()
    Dim sResponse As String, hTable As Object, id As String, lista() As String, rut As String
    Dim strBody As String
    id = Worksheets("Lista").Cells(2, 1).Value
    lista = Split(id, "-")
    rut = lista(0)

    strBody = "mm=12&aa=2017&rut=" & rut
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://www.cmfchile.cl//institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send strBody
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

    With CreateObject("htmlFile")
        .Write sResponse
        Set hTable = .getElementsByTagName("table")(1)
    End With
    Application.ScreenUpdating = False
    WriteTable hTable, 1, ActiveSheet
    Application.ScreenUpdating = True
End Sub

Public Sub WriteTable(ByVal hTable As Object, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
    R = startRow
    With ws
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                R = R + 1
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell             'DispHTMLElementCollection
                    .Cells(R, C).Value = td.innerText 'HTMLTableCell
                    C = C + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

使用浏览器（也使用上面的 WriteTable sub）

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, hTable As HTMLTable
    Application.ScreenUpdating = False
    With ie
        .Visible = True
        .navigate "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.getElementById("aa").Value = 2017
        .document.forms("consulta").submit
        Do
            DoEvents
            On Error Resume Next
            Set hTable = .document.getElementsByTagName("table")(1)
            On Error GoTo 0
        Loop While hTable Is Nothing

        WriteTable hTable, 1, ActiveSheet
    End With
    Application.ScreenUpdating = True
End Sub

输出：

参考资料：

通过 VBE > 工具 > 参考的 HTML 对象库

调整到您的代码大纲但仍在使用pestania = 27

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, hTable As HTMLTable, lista() As String, id As String, rut As String, enlace As String
    Application.ScreenUpdating = False

    id = Worksheets("Lista").Cells(2, 1).Value
    lista = Split(id, "-")
    rut = lista(0)
    enlace = "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=" & rut & "&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw+cAAhAABP4MAAz&control=svs&pestania=27"

    With ie
        .Visible = True
        .navigate enlace  '"http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.getElementById("aa").Value = 2017
        .document.forms("consulta").submit
        Do
            DoEvents
            On Error Resume Next
            Set hTable = .document.getElementsByTagName("table")(1)
            On Error GoTo 0
        Loop While hTable Is Nothing

        WriteTable hTable, 1, ActiveSheet
    End With
    Application.ScreenUpdating = True
End Sub

【讨论】：

多合一，很棒的答案！

【解决方案2】：

你已经得到了很好的答案。问题是当QHarr 决定上场时，他几乎没有给其他人留下任何选择的立场。但是，以下脚本将为您节省一些额外的时间。我使用 IE 获取page source，然后应用更快的方法来管理其余部分。我试图解析针对年份2016 填充的相关表格数据。随意根据您的要求更改年份。

Sub ScrapeTabularInfo()
    Dim IE As New InternetExplorer, Html As HTMLDocument
    Dim Htmldoc As New HTMLDocument, post As Object, elem As Object
    Dim trow As Object, R&, C&

    With IE
        .Visible = False
        .navigate "http://www.cmfchile.cl/institucional/mercados/entidad.php?auth=&send=&mercado=V&rut=9278&grupo=&tipoentidad=FINRE&vig=VI&row=AAAw%20cAAhAABP4MAAz&control=svs&pestania=27"
        While .Busy Or .readyState < 4: DoEvents: Wend
        Set Html = .document
        Html.querySelector("#aa").innerText = 2016
        Html.querySelector("input[value='Consultar']").Click
        Do: Set post = Html.getElementsByTagName("table")(1): DoEvents: Loop While post Is Nothing
    End With

    Htmldoc.body.innerHTML = Html.DocumentElement.outerHTML

    For Each elem In Htmldoc.getElementsByTagName("table")(1).Rows
        For Each trow In elem.Cells
            C = C + 1: Cells(R + 1, C) = trow.innerText
        Next trow
        C = 0: R = R + 1
    Next elem
    IE.Quit
End Sub

这里最好的方法是利用您已经有演示的post 请求。

添加到库的参考（考虑到您拥有IE9 或更高版本以使.querySelector() 正常工作）：

Microsoft Internet Controls
Microsoft HTML Object Libray

【讨论】：

我曾经冒险离开 querySelector :-) +1
使用form 是一个非常好的主意，您已经证明了这一点。