如何使用VBA从网上下载表格？

Question

我正在尝试从此页面下载表格  与VBA配合使用：http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx->表“ Panel General” 我可以下载“ Panel Merval”表，但无法下载其他表。

我将此代码用于表“ Panel Merval”：

Sub GetTable()

Dim ieApp As InternetExplorer
 Dim ieDoc As Object
 Dim ieTable As Object
 Dim clip As DataObject

'create a new instance of ie
 Set ieApp = New InternetExplorer

'you don’t need this, but it’s good for debugging
 ieApp.Visible = False

'now that we’re in, go to the page we want
 ieApp.Navigate "http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx"
 Do While ieApp.Busy: DoEvents: Loop
 Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop

'get the table based on the table’s id
 Set ieDoc = ieApp.Document
 Set ieTable = ieDoc.all.Item("ctl00_ContentCentral_tcAcciones_tpMerval_grdMerval")

'copy the tables html to the clipboard and paste to teh sheet
 If Not ieTable Is Nothing Then
 Set clip = New DataObject
 clip.SetText "" & ieTable.outerHTML & ""
 clip.PutInClipboard
 Sheet1.Select
 Sheet1.Range("b2").Select
 Sheet1.PasteSpecial "Unicode Text"
 End If

'close 'er up
 ieApp.Quit
 Set ieApp = Nothing


End Sub

或这个

Public Sub PanelLider()


Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim x As Long, y As Long
Dim oRow As Object, oCell As Object
Dim vData As Variant
Dim link As String

link = "http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx"

y = 1: x = 1

With CreateObject("msxml2.xmlhttp")
    .Open "GET", link, False
    .Send
    oDom.body.innerHTML = .ResponseText
End With

With oDom.getElementsByTagName("table")(27)
    Dim dataObj As Object
    Set dataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dataObj.SetText "<table>" & .innerHTML & "</table>"
    dataObj.PutInClipboard
End With
Sheets(2).Paste Sheets(2).Cells(1, 1)


End Sub

有人可以帮我下载表格“ Panel General”吗？

非常感谢。

Answer 1

硒

以下使用selenium basic获取表。

Option Explicit
Public Sub GetTable()
    Dim html As New HTMLDocument, htable As HTMLTable, headers()
    headers = Array("Especie", "Hora Cotización", "Cierre Anterior", "Precio Apertura", "Precio Máximo", _
"Precio Mínimo", "Último Precio", "Variación Diaria", "Volumen Efectivo ($)", "Volumen Nominal", "Precio Prom. Pon")
    With New ChromeDriver
        .get "http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx"
        .FindElementById("__tab_ctl00_ContentCentral_tcAcciones_tpGeneral").Click
        Do
        DoEvents
        Loop While .FindElementById("ctl00_ContentCentral_tcAcciones_tpGeneral_dgrGeneral", timeout:=7000).Text = vbNullString
        html.body.innerHTML = .PageSource
        Set htable = html.getElementById("ctl00_ContentCentral_tcAcciones_tpGeneral_dgrGeneral")
        WriteTable2 htable, headers, 1, ActiveSheet
        .Quit
    End With
End Sub

Public Sub WriteTable2(ByVal htable As HTMLTable, ByRef headers As Variant, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, c As Long, tBody As Object
    R = startRow: c = 1
    With ActiveSheet
        Set tRow = htable.getElementsByTagName("tr")
        For Each tr In tRow
            Set tCell = tr.getElementsByTagName("td")
            For Each td In tCell
                .Cells(R, c).Value = td.innerText
                c = c + 1
            Next td
            R = R + 1:  c = 1
        Next tr
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    End With
End Sub

---

参考：

1. HTML对象库
2. 硒类型库

---

使用IE（使用上方的WriteTable2子项）：

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, html As HTMLDocument, hTable As HTMLTable, headers(), a As Object
    headers = Array("Especie", "Hora Cotización", "Cierre Anterior", "Precio Apertura", "Precio Máximo", _
"Precio Mínimo", "Último Precio", "Variación Diaria", "Volumen Efectivo ($)", "Volumen Nominal", "Precio Prom. Pon")
    Application.ScreenUpdating = False
    With ie
        .Visible = True
        .navigate "http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.getElementById("__tab_ctl00_ContentCentral_tcAcciones_tpGeneral").Click
        Do
        DoEvents
        On Error Resume Next
        Set hTable = .document.getElementById("ctl00_ContentCentral_tcAcciones_tpGeneral_dgrGeneral")
        On Error GoTo 0
        Loop While hTable Is Nothing

        WriteTable2 hTable, headers, 1, ActiveSheet
        .Quit '<== Remember to quit application
        Application.ScreenUpdating = True
    End With
End Sub

---

参考：

1. Microsoft Internet Explorer控件