3

Boa tarde,

preciso acessar um site e pegar os dados do último dia e copiá-los para uma pasta no excel, o site é o destacado na macro abaixo, mas eu não sei como proceder para selecionar os dados e copiá-los na minha planilha.

Sub AcessarSite()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.application")
    With IE
        .Visible = True
        .Navigate ("http://www.cepea.esalq.usp.br/br/indicador/acucar.aspx")
        While .Busy Or .ReadyState <> 4:
            DoEvents:
        Wend
    'selecionar dados e copiá-los em células


        While .Busy Or .ReadyState <> 4:
            DoEvents:
        Wend
        Debug.Print .LocationURL
    End With
End Sub

Obrigado!!!

1

2 Respostas 2

1

Você pode varrer o site procurando procurando pelas Id dos getElementsById(). Pelo que vi no site as Id são imagenet-indicador1 e imagenet-indicador2.

Não testei o código, mas seria algo assim, fazendo um simples CTRL+C e CTRL+V.

    Set tables = document.getElementsById("imagenet-indicador1")
    Set table = tables(0)
    Set clipboard = New MSForms.DataObject

    clipboard.SetText table.outerHTML
    clipboard.PutInClipboard
    ActiveSheet.Paste

Você pode tentar também importar a pagina, e manipular os dados direto na planilha:

Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.cepea.esalq.usp.br/br/indicador/acucar.aspx", Destination:= _
        Range("$A$1"))
        .Name = "acucar_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
7
  • Legal obrigado, mas aparece erro de compilação no MSForms.DataObject, acredito que por não ter a microsoft forms 2.0 library, mas não consigo colocá-lo no meu excel. Há outra forma? 21/02/2017 às 20:35
  • Editei a resposta, acho que essa opção te ajuda. 21/02/2017 às 20:42
  • Me ajuda sim, muito obrigado, mas eu não consigo mesmo pegar só a primeira tabela né? 21/02/2017 às 20:45
  • Dependendo de como o site foi construindo consegue sim, mas no caso desse eu não consegui. Mas de uma olhada aqui, talvez você consiga melhorar o meu código msdn.microsoft.com/en-us/library/bb223048(v=office.12).aspx 21/02/2017 às 20:52
  • Obrigado amigo, mas o link está quebrado! 21/02/2017 às 20:56
0

Consegui copiar somente a tabela desejada na minha planilha com o código abaixo:

Sub AcessarSite()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.application")
    With IE
        .Visible = True
        .Navigate ("http://www.cepea.esalq.usp.br/br/indicador/acucar.aspx")
        While .Busy Or .ReadyState <> 4:
            DoEvents:
        Wend
    'selecionar dados e copiá-los em células
Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.cepea.esalq.usp.br/br/indicador/acucar.aspx", Destination:= _
        Range("$A$1"))
        .Name = "acucar_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "1"
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

        While .Busy Or .ReadyState <> 4:
            DoEvents:
        Wend
        Debug.Print .LocationURL
    End With

    IE.Quit

End Sub

É possível atualizar automaticamente uma outra planilha com o dado da última data assim que eu dar "play" na macro?

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 .