0

I'am trying to download a table from this page to excel with VBA: http://www.merval.sba.com.ar/Vistas/Cotizaciones/Acciones.aspx --> table "Panel General" I can download the table "Panel Merval" but i couldn't download the other table.

I use this code for table "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

or this one

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

Could someone help me to download the table "Panel General"?

Many thanks.

QHarr
  • 83,427
  • 12
  • 54
  • 101
  • Possible duplicate of [Fetch specific table only from website into Excel](https://stackoverflow.com/questions/12989687/fetch-specific-table-only-from-website-into-excel) – Comintern Jul 24 '18 at 03:10
  • IMO (non expert) -This is not a duplicate of that question as this one involves both tab negotiating and handling the fact is ajax based loading. The method in that question could only be applied if the correct POST request was formulated, but there is insufficient detail in that question to make using it possible. – QHarr Jul 24 '18 at 08:00

1 Answers1

1

Selenium

The following gets the table using 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

References:

  1. HTML Object Library
  2. Selenium Type Library

With IE (Using WriteTable2 sub from above):

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

References:

  1. Microsoft Internet Explorer Controls
QHarr
  • 83,427
  • 12
  • 54
  • 101