0

Eu estou tentando extrair uma tabela específica de um site e colar em uma planilha para atualizar diariamente um banco de dados. Mas como é impossível baixar a tabela como excel ou csv, devo extrair a tabela diretamente do site.

Segue meu código e onde estou com problema (onde está escrito "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
2
  • O idioma do site é Portugues. Traduza sua pergunta.
    – user28595
    Commented 3/01/2019 às 13:41
  • Cross Post Commented 7/01/2019 às 16:19

1 Resposta 1

0

Mais ou menos assim:

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

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .