How to extract data from internet by VBA

Asked

Viewed 2,783 times

0

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

Follow my code and where I’m in trouble (where it says "HERE").

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
  • The language of the site is Portugues. Translate your question.

1 answer

0

Sort of 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

Browser other questions tagged

You are not signed in. Login or sign up in order to post.