none
Macro para obter dados de uma pagina no excel RRS feed

  • Pergunta

  • Preciso fazer uma macro que extraia os dados de Estações de Vazão do ANA, vi nesta rede um código similar ao que eu preciso feito por Felipe Costa. Tentei ajustar para o que eu preciso, entretanto no meu problema eu tenho que clicar em cada código de estação e extrair as informações e envia-las para excel, rodarei essa macro todos os dias e acredito que o ID seja dinamico, oq é um problema... Enfim, preciso muito de ajuda... 

    O site de que eu preciso retirar as informações é este: 

    - Devo extrair as informações para cada uma dessas estações

    -Não é todos os dias que terei informação em todas as estações: O monitoramento pode ser realizado em apenas 3 delas, ou em nenhuma em determinado dia, para essas pensei em colocar uma infomação "não houve monitoramento dd/mm/aaaa"

    http://mapas-hidro.ana.gov.br/Usuario/ultimo.aspx?dado=Vazao&nivel=3&bacia=40&origem=5

    Function Codigo(sEstacoes As String)



        Const lIntervalo As Long = 2000

        Const sElementoInício As String = "<TABLE"
        Const sElementoFim As String = "</TABLE>"

        Dim IE As Object
        Dim MyData As DataObject
        Dim ws As Worksheet

        Dim sHTMLBody As String
        Dim lInício As Long
        Dim lFim As Long

    Set IE = CreateObject("InternetExplorer.Application")
        On Error GoTo Tratamento
      
        IE.Visible = True
        IE.navigate "http://mapas-hidro.ana.gov.br/Usuario/ultimo.aspx?dado=Vazao&nivel=3&bacia=40&origem=5"
        
        'READYSTATE_COMPLETE é a mesma coisa que 4.
        While IE.readyState <> 4: DoEvents: Wend
        'IE.document.forms.Item(0).all.Item("ID do item").Value = sEstacoes
        'Sleep lIntervalo
        IE.document.forms.Item(0).all.Item("grd__ctl2_A1").Click
        Sleep lIntervalo
        IE.document.forms.Item(0).all.Item("image1").Click
        Sleep lIntervalo
        IE.document.forms.Item(1).all.Item("image1").Click
        Sleep lIntervalo
       
        sHTMLBody = IE.document.DocumentElement.outerHTML
        lInício = InStr(1, sHTMLBody, sElementoInício)
        lFim = InStr(1, sHTMLBody, sElementoFim) + Len(sElementoFim)
       
        Set MyData = New DataObject
        MyData.SetText Mid(sHTMLBody, lInício, lFim - lInício)
        MyData.PutInClipboard
       
        Set ws = Sheets.Add
        ws.Name = sEstacoes
        ws.Paste
       
    Tratamento:
        IE.Quit

    End Function

    domingo, 29 de março de 2015 23:27