Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Application.OnTime desregulado
Application.OnTime desregulado
Olá boa noite,
Estou aprendendo VBA e estou tendo um problema com um script que fiz. Periodicamente ele deve coletar dados de um site via selenium e salvar em uma planilha.
De acordo com a rotina criada, de 5 em 5 minutos o Excel deveria rodar o script e apresentar os dados. Durante um tempo isso ocorre corretamente(umas 3 horas mais ou menos), porem percebo que (por algo que eu ainda não sei o que é) esse tempo começa a ficar menor, de 5 para 4 minutos, depois 2 até que fica em loop infinito. Não sei o que pode ser, já pesquisei muito e até em sites gringos e não achei resposta para isso, minha ultima tentativa vai ser aqui que eu acho a comunidade mais fera em VBA da internet brasileira.
Desde já obrigado.
Estou aprendendo VBA e estou tendo um problema com um script que fiz. Periodicamente ele deve coletar dados de um site via selenium e salvar em uma planilha.
De acordo com a rotina criada, de 5 em 5 minutos o Excel deveria rodar o script e apresentar os dados. Durante um tempo isso ocorre corretamente(umas 3 horas mais ou menos), porem percebo que (por algo que eu ainda não sei o que é) esse tempo começa a ficar menor, de 5 para 4 minutos, depois 2 até que fica em loop infinito. Não sei o que pode ser, já pesquisei muito e até em sites gringos e não achei resposta para isso, minha ultima tentativa vai ser aqui que eu acho a comunidade mais fera em VBA da internet brasileira.
Desde já obrigado.
Re: Application.OnTime desregulado
Dim driver As New ChromeDriver
Public Sub Novoscrap()
Dim ck As New By
Dim w As Worksheet
Dim r As Range
Dim m As Worksheet
Dim linkSemEscanteio As Variant
Dim celulaApagar As Integer
Application.EnableCancelKey = xlDisabled
Application.OnTime Now + TimeValue("00:05:00"), "validaHora"
If PlanEstats.Range("A2") <> "" Then
PlanEstats.Select
PlanEstats.Rows("2:110").Select
Selection.Delete Shift:=xlUp
End If
Set m = Sheets("Links")
m.Select
m.Range("A2").Select
If ActiveCell.Value = "" Then
MsgBox "Sem link valida na celula A2 da Aba Jogos de Hoje."
Exit Sub
End If
Set driver = New ChromeDriver
driver.AddArgument ("--headless")
Do While ActiveCell.Value <> ""
driver.Get (ActiveCell.Value)
On Error Resume Next
If driver.IsElementPresent(ck.XPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[2]/div[1]/span/span[1]"), 0) And driver.IsElementPresent(ck.XPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[1]/div[4]/div[2]/div[2]/span"), 0) Then
Set TDados = Sheets("Coleta dados").ListObjects("Tbextrai")
Set novodado = TDados.ListRows.Add
novodado.Range(1, 1).Value = driver.FindElementByXPath("//*[@id=""app""]/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[2]/div[1]/span", 0).Text
novodado.Range(1, 2).Value = driver.FindElementByXPath("//*[@id=""app""]/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[2]/div[2]/span", 0).Text
novodado.Range(1, 3).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[1]", 0).Text
novodado.Range(1, 4).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[3]", 0).Text
novodado.Range(1, 5).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[2]/div[1]/span[1]", 0).Text
novodado.Range(1, 6).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[2]/div[1]/span[3]", 0).Text
novodado.Range(1, 7).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[3]/div[1]/span[1]", 0).Text
novodado.Range(1, 8).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[3]/div[1]/span[3]", 0).Text
novodado.Range(1, 9).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[1]/div[1]/span[1]", 0).Text
novodado.Range(1, 10).Value = driver.FindElementByXPath("html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[1]/div[1]/span[3]", 0).Text
novodado.Range(1, 11).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[7]/div[1]/span[1]", 0).Text
novodado.Range(1, 12).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[7]/div[1]/span[3]", 0).Text
novodado.Range(1, 13).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[5]/div[1]/span[1]", 0).Text
novodado.Range(1, 14).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[5]/div[1]/span[3]", 0).Text
novodado.Range(1, 15).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[8]/div[1]/span[1]", 0).Text
novodado.Range(1, 16).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[8]/div[1]/span[3]", 0).Text
novodado.Range(1, 17).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[9]/div[1]/span[1]", 0).Text
novodado.Range(1, 18).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[9]/div[1]/span[3]", 0).Text
novodado.Range(1, 19).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[2]/div[1]/span/span[1]", 0).Text
ActiveCell.Offset(1, 0).Select
Else
Planilha3.Select
If Range("F23").Value <> "" Then
Set r = ActiveCell.Rows
Range("F23").Select
ActiveCell.Copy
r.Select
ActiveCell.PasteSpecial
Rows("23:23").Delete
Else
Set TDados = Sheets("Coleta dados").ListObjects("Tbextrai")
Set novodado = TDados.ListRows.Add
novodado.Range(1, 1) = "Trocar Link"
novodado.Range(1, 2) = "Trocar Link"
ActiveCell.Offset(1, 0).Select
End If
End If
Loop1:
Loop
driver.Quit
End Sub
Public Sub Novoscrap()
Dim ck As New By
Dim w As Worksheet
Dim r As Range
Dim m As Worksheet
Dim linkSemEscanteio As Variant
Dim celulaApagar As Integer
Application.EnableCancelKey = xlDisabled
Application.OnTime Now + TimeValue("00:05:00"), "validaHora"
If PlanEstats.Range("A2") <> "" Then
PlanEstats.Select
PlanEstats.Rows("2:110").Select
Selection.Delete Shift:=xlUp
End If
Set m = Sheets("Links")
m.Select
m.Range("A2").Select
If ActiveCell.Value = "" Then
MsgBox "Sem link valida na celula A2 da Aba Jogos de Hoje."
Exit Sub
End If
Set driver = New ChromeDriver
driver.AddArgument ("--headless")
Do While ActiveCell.Value <> ""
driver.Get (ActiveCell.Value)
On Error Resume Next
If driver.IsElementPresent(ck.XPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[2]/div[1]/span/span[1]"), 0) And driver.IsElementPresent(ck.XPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[1]/div[4]/div[2]/div[2]/span"), 0) Then
Set TDados = Sheets("Coleta dados").ListObjects("Tbextrai")
Set novodado = TDados.ListRows.Add
novodado.Range(1, 1).Value = driver.FindElementByXPath("//*[@id=""app""]/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[2]/div[1]/span", 0).Text
novodado.Range(1, 2).Value = driver.FindElementByXPath("//*[@id=""app""]/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[2]/div[2]/span", 0).Text
novodado.Range(1, 3).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[1]", 0).Text
novodado.Range(1, 4).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[3]", 0).Text
novodado.Range(1, 5).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[2]/div[1]/span[1]", 0).Text
novodado.Range(1, 6).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[2]/div[1]/span[3]", 0).Text
novodado.Range(1, 7).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[3]/div[1]/span[1]", 0).Text
novodado.Range(1, 8).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[3]/div[1]/span[3]", 0).Text
novodado.Range(1, 9).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[1]/div[1]/span[1]", 0).Text
novodado.Range(1, 10).Value = driver.FindElementByXPath("html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[1]/div[1]/span[3]", 0).Text
novodado.Range(1, 11).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[7]/div[1]/span[1]", 0).Text
novodado.Range(1, 12).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[7]/div[1]/span[3]", 0).Text
novodado.Range(1, 13).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[5]/div[1]/span[1]", 0).Text
novodado.Range(1, 14).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[5]/div[1]/span[3]", 0).Text
novodado.Range(1, 15).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[8]/div[1]/span[1]", 0).Text
novodado.Range(1, 16).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[8]/div[1]/span[3]", 0).Text
novodado.Range(1, 17).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[9]/div[1]/span[1]", 0).Text
novodado.Range(1, 18).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[4]/span/div/div[3]/div[2]/div[1]/div[3]/div[9]/div[1]/span[3]", 0).Text
novodado.Range(1, 19).Value = driver.FindElementByXPath("/html/body/div/div/div/div[3]/div[2]/div[2]/div[2]/div[2]/div[1]/span/span[1]", 0).Text
ActiveCell.Offset(1, 0).Select
Else
Planilha3.Select
If Range("F23").Value <> "" Then
Set r = ActiveCell.Rows
Range("F23").Select
ActiveCell.Copy
r.Select
ActiveCell.PasteSpecial
Rows("23:23").Delete
Else
Set TDados = Sheets("Coleta dados").ListObjects("Tbextrai")
Set novodado = TDados.ListRows.Add
novodado.Range(1, 1) = "Trocar Link"
novodado.Range(1, 2) = "Trocar Link"
ActiveCell.Offset(1, 0).Select
End If
End If
Loop1:
Loop
driver.Quit
End Sub
Re: Application.OnTime desregulado
Public Sub validaHora()
Dim w As Worksheet
Dim inicio As Date
Dim fim As Date
Dim r As Integer
Dim ultcell As Range
Dim m As Worksheet
Dim x As Long
Dim prefixo As String
Dim linha As Range
Dim celulaApagar As Variant
Dim linkSemEscanteio As Variant
Dim checkLink As Boolean
Dim procuraLink As Range
Set m = Sheets("Links")
Set w = Sheets("Links com Hora")
m.Select
If Range("F23") = "" Then
Range("F23") = "Jogo ficticio"
Range("F24") = "Jogo ficticio"
End If
w.Select
Range("B2").Select
Do While ActiveCell.Value <> ""
inicio = ActiveCell.Value
If inicio < Time() Then
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
m.Select
Range("F23").Select
Set linha = Range("F23").End(xlDown)
linha.Select
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial
w.Select
r = ActiveCell.Row
Rows(r).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
m.Select
Rows("23:24").Select
Selection.Delete
Range("h23").Select
Do While ActiveCell.Value <> ""
fim = ActiveCell.Value
If fim > Time() Then
ActiveCell.Offset(1, 0).Select
Else
r = ActiveCell.Row
Rows(r).Select
Selection.Delete Shift:=xlUp
ActiveCell.Select
ActiveCell.Offset(0, 7).Select
End If
Loop
Columns("G:H").Select
Selection.Delete Shift:=xlUp
If Range("A22") <> "" Then
End If
Call Novoscrap
End Sub
Dim w As Worksheet
Dim inicio As Date
Dim fim As Date
Dim r As Integer
Dim ultcell As Range
Dim m As Worksheet
Dim x As Long
Dim prefixo As String
Dim linha As Range
Dim celulaApagar As Variant
Dim linkSemEscanteio As Variant
Dim checkLink As Boolean
Dim procuraLink As Range
Set m = Sheets("Links")
Set w = Sheets("Links com Hora")
m.Select
If Range("F23") = "" Then
Range("F23") = "Jogo ficticio"
Range("F24") = "Jogo ficticio"
End If
w.Select
Range("B2").Select
Do While ActiveCell.Value <> ""
inicio = ActiveCell.Value
If inicio < Time() Then
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
m.Select
Range("F23").Select
Set linha = Range("F23").End(xlDown)
linha.Select
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial
w.Select
r = ActiveCell.Row
Rows(r).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
m.Select
Rows("23:24").Select
Selection.Delete
Range("h23").Select
Do While ActiveCell.Value <> ""
fim = ActiveCell.Value
If fim > Time() Then
ActiveCell.Offset(1, 0).Select
Else
r = ActiveCell.Row
Rows(r).Select
Selection.Delete Shift:=xlUp
ActiveCell.Select
ActiveCell.Offset(0, 7).Select
End If
Loop
Columns("G:H").Select
Selection.Delete Shift:=xlUp
If Range("A22") <> "" Then
End If
Call Novoscrap
End Sub
Re: Application.OnTime desregulado
Desde já muito obrigado pela ajuda e desculpe se o código estiver fora do padrão pois estou aprendendo aos poucos com funciona cada função do vba.