Usuário com melhor resposta
Formatar os dados puxados de uma HTML que estão em formato data para "DD/MM/AA"

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
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 objRefSet ie = New InternetExplorer
ie.Navigate "http://www.bmfbovespa.com.br/cronograma-eventos/CronogramaEventos.aspx?Idioma=pt-br"
ie.Visible = TrueDo While ie.Busy
Loop
Do Until ie.Document.ReadyState = "complete"
LoopSet objRef = ie.Document.all("ctl00_contentPlaceHolderConteudo_rptTabelaItems_ctl09_lnkBtnDescricao")
objRef.ClickDo While ie.Busy
Loop
Do Until ie.Document.ReadyState = "complete"
LoopSet 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 tSheets(1).Select
Range("s3:s5").Select
Selection.ClearContentsie.Quit
Set ie = Nothing
End Sub- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 14 de junho de 2014 16:05
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 14 de junho de 2014 16:05
Todas as Respostas
-
-
Obrigado, Bruno. Acabei conseguindo com a seguinte adaptação:
If IsDate(elemCollection(t).Rows(r).Cells(c).innerText) ThenThisWorkbook.Worksheets("BancoDados").Range("I65536").End(xlUp).Offset(1, c) = CDate(elemCollection(t).Rows(r).Cells(c).innerText)ElseThisWorkbook.Worksheets("BancoDados").Range("I65536").End(xlUp).Offset(1, c) = elemCollection(t).Rows(r).Cells(c).innerTextEnd IfAbraços,
Silmar
-
-
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 objRefSet ie = New InternetExplorer
ie.Navigate "http://www.bmfbovespa.com.br/cronograma-eventos/CronogramaEventos.aspx?Idioma=pt-br"
ie.Visible = TrueDo While ie.Busy
Loop
Do Until ie.Document.ReadyState = "complete"
LoopSet objRef = ie.Document.all("ctl00_contentPlaceHolderConteudo_rptTabelaItems_ctl09_lnkBtnDescricao")
objRef.ClickDo While ie.Busy
Loop
Do Until ie.Document.ReadyState = "complete"
LoopSet 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 tSheets(1).Select
Range("s3:s5").Select
Selection.ClearContentsie.Quit
Set ie = Nothing
End Sub- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 14 de junho de 2014 16:05
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 14 de junho de 2014 16:05
-