estou com um código que me atende perfeitamente quando realizo o debug manualmente (linha a linha - F8), porém quando mando executar via "botão" ou "play" ocorre sempre o mesmo erro (Erro Exceção de HRESULT: 0x800A03EC) na linha "tabela.AsTable.ToExcel Destino", então mando depurar e aperto F8 e o mesmo avança sem acusar erro... isso que eu acho estranho, pois avança sem precisar tratar nada. Por favor, podem me ajudar?
Código na integra:
Código: Selecionar todos
ub extrairTabelasWeb()
'FALTA TRATAR UNIDADES DE MEDIDAS PARA KM/H
Set driver = New ChromeDriver
driver.AddArgument ("--headless")
Dim iLnhCidade As Integer
Dim URL_Cidade As String
Dim NomeCidade As String
iLnhCidade = 2
'verificar qual cidade para coleta
While Worksheets("Alerta_Temporal").Range("CM" & iLnhCidade) <> ""
'grava url da cidade
URL_Cidade = Worksheets("Alerta_Temporal").Range("CQ" & iLnhCidade)
'grava nome da cidade
NomeCidade = Worksheets("Alerta_Temporal").Range("CM" & iLnhCidade)
'definir local para gravar dados coletados
Dim Destino As Range
'identifica ultima linha com valores
Worksheets("Alerta_Temporal").Activate
Worksheets("Alerta_Temporal").Range("B1048576").Activate
Selection.End(xlUp).Activate
'verifica se é o primeiro valor a receber
If ActiveCell.Offset(0, 0).Value <> "" Then
'se houver valores, pula 2 linhas abaixo
ActiveCell.Offset(2, 0).Activate
cabecalho = "nao"
End If
'define local para receber valores
Set Destino = ActiveCell.Offset(0, 0).Range("A1")
'carrega site da cidade
driver.get URL_Cidade
Dim tabela As WebElement
'localiza tabela de interesse
Set tabela = driver.FindElementById("detail-data-table")
If tabela Is Nothing Then
MsgBox "Elemento não encontrado"
Else
'On Error GoTo Trata_Erro não sei como pular o erro, tentativa
tabela.AsTable.ToExcel Destino 'AQUI OCORRE O ERRO - Erro Exceção de HRESULT: 0x800A03EC
'tratamento layout
If cabecalho = "nao" Then
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(2, 43)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
ActiveCell.Select
End If
End If
'tratamento layout
If cabecalho = "nao" Then
ActiveCell.Offset(0, -1) = NomeCidade
ActiveCell.Offset(1, -1) = "Chuva mm"
ActiveCell.Offset(2, -1) = "Vento km/h"
ActiveCell.Offset(3, -1) = "Rajadas km"
ActiveCell.Offset(4, -1) = "Direcao"
Else
ActiveCell.Offset(0, -1) = NomeCidade
End If
'busca nova cidade
iLnhCidade = iLnhCidade + 1
Wend
'fecha navegador
driver.Quit
'tratamento dos dados
Dim aLnh As Integer
Dim Col As Integer
Dim ValorData
Dim ContData As Integer
ContData = 0
ValorData = Date
ValorData = Format(ValorData, "DD,DDD")
aLnh = 0
Col = 0
'TRATAR CABEÇALHO - DIA DA SEMANA COM A HORA
Range("B1").Activate
While ActiveCell.Offset(aLnh + 1, Col).Value <> ""
'ActiveCell.Offset(aLnh + 1, Col).Activate
If ActiveCell.Offset(aLnh + 1, Col) <> 0 Then
ActiveCell.Offset(0, Col) = ValorData
Else
ContData = ContData + 1
ValorData = Date + ContData
ValorData = Format(ValorData, "DD,DDD")
ActiveCell.Offset(0, Col) = ValorData
End If
Col = Col + 1
Wend
Worksheets("Alerta_Temporal").Range("B1").Activate
End Sub
download/file.php?mode=view&id=5124
Obrigado a todos!