How to extract data from the internet by VBA

Question

How to extract data from the internet by VBA

I am trying to extract a specific table from a site and paste into a spreadsheet to daily update a database. But since it is impossible to download the table as excel or csv, I should extract the table directly from the site.

Follows my code and where I am with problem (where "here"is written).

Sub Daily()

'Create Internet Explorer Browser
Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

'Ask Browser to navigate to website (.Visible=False will hide IE when running)
With appIE
    .Navigate "https://www.infomoney.com.br/mercados/ferramentas/contratos-di-futuro"
    .Visible = True
End With

'Have the macro pause while IE is busy opening and navigating
Do While appIE.Busy
    DoEvents
Loop

'Designate the table to be extracted and Copy the data from table - HERE



'Close IE and clear memory
appIE.Quit
Set appIE = Nothing

'Clear area and paste extracted text into the appropriate sheet/cells - HERE
Worksheets("Sheet1").Range("A2:H1000").ClearContents
Sheets("PPG").Select
Range("A2").Select
End Sub

0

vba internet-explorer excel-vba macro

Author: Erlon Charles, 2019-01-03

Source

1 answers

score 0 · Answer 1

Something like this:

Sub Daily()
    Worksheets(1).Select
    'Create Internet Explorer Browser
    Dim appIE As Object
    Set appIE = CreateObject("internetexplorer.application")

    'Ask Browser to navigate to website (.Visible=False will hide IE when running)
    With appIE
        .Navigate "https://www.infomoney.com.br/mercados/ferramentas/contratos-di-futuro"
        .Visible = True
    End With

    'Have the macro pause while IE is busy opening and navigating
    Do While appIE.Busy
        DoEvents
    Loop
    'ADICIONANDO TEMPO PARA CARREGAR A PAGINA
    Application.Wait CDate(Now + TimeSerial(0, 0, 8))
    'DESABILITANDO ATUALIZACAO DE CALCULOS PARA AGILIZAR A EXECUCAO
    Application.Calculation = xlCalculationManual

    Set ieTable = appIE.Document.getElementsByClassName("border-t-brown-3 quotations-im-table table-scroll")(0)
    Set TDelements = ieTable.getElementsByTagName("td")
    Set THelements = ieTable.getElementsByTagName("th")

    Range("B1").Select
    For Each th In THelements
        If c1 < 8 Then
            ActiveCell.Offset(l1, c1).Value = th.innerText
            c1 = c1 + 1
        End If
    Next th
    c1 = 0
    ActiveCell.Offset(1, 0).Select

    For Each td In TDelements
        ActiveCell.Offset(l1, c1).Value = td.innerText
        c1 = c1 + 1
        If c1 Mod 8 = 0 Then
            l1 = l1 + 1
            c1 = 0
        End If
    Next td

    appIE.Quit
    Set appIE = Nothing

    Range("F:F").Select
    Selection.NumberFormat = "dd/mm/yyyy hh:mm;@"

    Cells.Select
    Cells.EntireColumn.AutoFit
    'Clear area and paste extracted text into the appropriate sheet/cells - HERE
    'Worksheets(1).Range("A2:H1000").ClearContents
    'Sheets(2).Select
    'Range("A2").Select
End Sub