none
Formatar os dados puxados de uma HTML que estão em formato data para "DD/MM/AA" RRS feed

  • Pergunta

  • Ilustres mestres,

    Criei uma rotina para baixar os dados de uma determinada página na WEB. Alguns dados são datas, e percebi que quando "baixa" essas informações alguns estão sendo baixados "invertidos".

    Por exemplo:
    Na Web está: 12/03/11
    Puxa na plan : 03/12/11

    Como faço para adaptar a rotina, de modo que ela verefique e puxe os dados apenas no formato "DD/MM/AA", no formato brasileiro.

    Segue a rotina:

    Sub DataBalancoDFA()
    ' Baixa a data prevista para publicação do Balanço do 4º Trimestre (anual consolidado)

    Dim ie As InternetExplorer
    Dim t As Integer
    Dim r As Integer, c As Integer
    Dim elemCollection As Object
    Dim objRef

    Set ie = New InternetExplorer
    ie.Navigate "http://www.bmfbovespa.com.br/cronograma-eventos/CronogramaEventos.aspx?Idioma=pt-br"
    ie.Visible = True

    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set objRef = ie.Document.all("ctl00_contentPlaceHolderConteudo_rptTabelaItems_ctl09_lnkBtnDescricao")
    objRef.Click
    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set elemCollection = ie.Document.getElementsByTagName("TABLE")

    For t = 0 To elemCollection.Length - 1
    For r = 0 To elemCollection(t).Rows.Length - 1
    If elemCollection(t).Rows(r).Cells.Length > 7 Then

    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0) = elemCollection(t).Rows(r).Cells(0).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 1) = elemCollection(t).Rows(r).Cells(1).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 2) = elemCollection(t).Rows(r).Cells(2).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 3) = elemCollection(t).Rows(r).Cells(3).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 4) = elemCollection(t).Rows(r).Cells(4).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 5) = elemCollection(t).Rows(r).Cells(5).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 6) = elemCollection(t).Rows(r).Cells(6).innerText
    ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Offset(0, 7) = elemCollection(t).Rows(r).Cells(7).innerText

    End If

    Next r
    Next t

    ie.Quit
    Set ie = Nothing


    End Sub


    Agradeço imensamente, quem puder me ajudar.

    Silmar

    domingo, 3 de abril de 2011 08:39

Respostas

  • Não sei se é a forma mais correta, mas pelo menos está funcionando aqui no meu sisteminha. Se alguém quiser sugerir melhorias, agradeceria. Segue a rotina completa:

    Sub DataBalancoDFA()

    ' Baixa a data prevista para publicação do Balanço do 4º Trimestre (anual consolidado)

    Dim ie As InternetExplorer
    Dim t As Integer
    Dim r As Integer, c As Integer
    Dim elemCollection As Object
    Dim objRef

    Set ie = New InternetExplorer
    ie.Navigate "http://www.bmfbovespa.com.br/cronograma-eventos/CronogramaEventos.aspx?Idioma=pt-br"
    ie.Visible = True

    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set objRef = ie.Document.all("ctl00_contentPlaceHolderConteudo_rptTabelaItems_ctl09_lnkBtnDescricao")
    objRef.Click

    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set elemCollection = ie.Document.getElementsByTagName("TABLE")

    For t = 0 To elemCollection.Length - 1
    For r = 0 To elemCollection(t).Rows.Length - 1
    If IsDate(elemCollection(t).Rows(r).Cells.Length > 3) Then
    On Error Resume Next
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(1, 0) = elemCollection(t).Rows(r).Cells(0).innerText
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 1) = CDate(elemCollection(t).Rows(r).Cells(4).innerText)
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 2) = CDate(elemCollection(t).Rows(r).Cells(5).innerText)
    Else
    On Error Resume Next
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(1, 0) = elemCollection(t).Rows(r).Cells(0).innerText
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 1) = CDate(elemCollection(t).Rows(r).Cells(4).innerText)
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 2) = CDate(elemCollection(t).Rows(r).Cells(5).innerText)
    End If
    Next r
    Next t

    Sheets(1).Select
         Range("s3:s5").Select
           Selection.ClearContents

    ie.Quit
    Set ie = Nothing


    End Sub

    terça-feira, 5 de abril de 2011 21:15

Todas as Respostas

  • Use 

     

    Format(suaData,"dd/mm/yyyy")

     

    Teste ai e qqer coisa fale..

    Att 


    Bruno Silva Leite
    officevb.com
    terça-feira, 5 de abril de 2011 01:00
  • Obrigado, Bruno. Acabei conseguindo com a seguinte adaptação:

    If IsDate(elemCollection(t).Rows(r).Cells(c).innerText) Then
            ThisWorkbook.Worksheets("BancoDados").Range("I65536").End(xlUp).Offset(1, c) = CDate(elemCollection(t).Rows(r).Cells(c).innerText)
        Else
            ThisWorkbook.Worksheets("BancoDados").Range("I65536").End(xlUp).Offset(1, c) = elemCollection(t).Rows(r).Cells(c).innerText
        End If

     

    Abraços,

    Silmar

    terça-feira, 5 de abril de 2011 02:48
  • Silmar,

    Como ficou o procedimento completo?


    jose
    terça-feira, 5 de abril de 2011 14:19
  • Não sei se é a forma mais correta, mas pelo menos está funcionando aqui no meu sisteminha. Se alguém quiser sugerir melhorias, agradeceria. Segue a rotina completa:

    Sub DataBalancoDFA()

    ' Baixa a data prevista para publicação do Balanço do 4º Trimestre (anual consolidado)

    Dim ie As InternetExplorer
    Dim t As Integer
    Dim r As Integer, c As Integer
    Dim elemCollection As Object
    Dim objRef

    Set ie = New InternetExplorer
    ie.Navigate "http://www.bmfbovespa.com.br/cronograma-eventos/CronogramaEventos.aspx?Idioma=pt-br"
    ie.Visible = True

    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set objRef = ie.Document.all("ctl00_contentPlaceHolderConteudo_rptTabelaItems_ctl09_lnkBtnDescricao")
    objRef.Click

    Do While ie.Busy
    Loop
    Do Until ie.Document.ReadyState = "complete"
    Loop

    Set elemCollection = ie.Document.getElementsByTagName("TABLE")

    For t = 0 To elemCollection.Length - 1
    For r = 0 To elemCollection(t).Rows.Length - 1
    If IsDate(elemCollection(t).Rows(r).Cells.Length > 3) Then
    On Error Resume Next
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(1, 0) = elemCollection(t).Rows(r).Cells(0).innerText
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 1) = CDate(elemCollection(t).Rows(r).Cells(4).innerText)
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 2) = CDate(elemCollection(t).Rows(r).Cells(5).innerText)
    Else
    On Error Resume Next
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(1, 0) = elemCollection(t).Rows(r).Cells(0).innerText
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 1) = CDate(elemCollection(t).Rows(r).Cells(4).innerText)
    ThisWorkbook.Worksheets(1).Range("s65536").End(xlUp).Offset(0, 2) = CDate(elemCollection(t).Rows(r).Cells(5).innerText)
    End If
    Next r
    Next t

    Sheets(1).Select
         Range("s3:s5").Select
           Selection.ClearContents

    ie.Quit
    Set ie = Nothing


    End Sub

    terça-feira, 5 de abril de 2011 21:15
  • Valeu Bravocc,

    Aquí funcionou perfeito. Muito obrigado pela atenção.


    jose
    quarta-feira, 6 de abril de 2011 21:42