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

Question

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

Answer 1

Use 

 

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

 

Teste ai e qqer coisa fale..

Att 

---

Bruno Silva Leite
officevb.com

Answer 2

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

Answer 3

Silmar,

Como ficou o procedimento completo?

---

jose

Answer 4

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

Answer 5

Valeu Bravocc,

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

---

jose