La richiesta del refresh costringe e suggerisce varie modifiche nell'impostazione del codice.
La mia soluzione prevede la rivisitazione del codice gia' proposto (sia la Sub CALL che la Sub GetTabbbSub, che vanno sostituite in toto):
- Codice: Seleziona tutto
Dim Esito As Boolean 'Rigorosamente in testa al Modulo
Sub CALL2()
Dim myC As Long, eSh As Worksheet
Set eSh = ThisWorkbook.Sheets("Web") '<<< Il foglio su cui si fara' l'importazione
I = eSh.Range("AA1") ' 20190609 'Range("AA1") in AA1 va messo anno mese giorno di ricerca esempio 20190609
If eSh.Range("AA1") <> "" Then
Do
DoEvents
Call GetTabbbSub("https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & "", eSh)
If Esito Then Exit Do
myC = myC + 1
If myC > 2 Then Exit Do
Loop
eSh.Cells.WrapText = False
End If
If Esito Then
eSh.Range("AA2") = Now + TimeValue("00:05:00") 'Ripeti lento
Else
eSh.Range("AA2") = Now + TimeValue("00:01:00") 'Ripeti veloce
End If
Application.OnTime eSh.Range("AA2"), "CALL2"
End Sub
Sub GetTabbbSub(ByVal myURL As String, ByRef tSh As Worksheet)
'Va Chiamata passandogli l'URL da leggere E il foglio di destinazione dei dati
'myURL = "https://www.lottomaticaitalia.it/del/estrazioni-e-vincite/popup-pdf/estrazioni-giorno.html?data=" & I & ""
' Application.ScreenUpdating = False
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate myURL
' .Visible = True
.Visible = False
''Stop '*** VEDI Testo
Do While .Busy: DoEvents: Loop 'Attesa not busy
Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
myStart = Timer 'attesa addizionale
Do
DoEvents
If Timer > myStart + 0.5 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle SUL FOGLIO ATTIVO
' Application.ScreenUpdating = False
Set mycoll = IE.document.getElementsByTagName("TABLE")
If mycoll.Length > 0 Then
tSh.Range("A1:X400").ClearContents ' cancella dati
For Each myItm In mycoll
tSh.Cells(I + 1, 1) = "Table# " & ti + 1
ti = ti + 1: I = I + 1
For Each tRTr In myItm.Rows
For Each tdtd In tRTr.Cells
tSh.Cells(I + 1, j + 1) = tdtd.innerText
j = j + 1
DoEvents
Next tdtd
I = I + 1: j = 0
DoEvents
Next tRTr
I = I + 1
Next myItm
Esito = True
Else
Esito = False
End If
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
PIU' questa aggiunta da mettere nel modulo ThisWorkbook:
- Codice: Seleziona tutto
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("Web").Range("AA2").Value >= Now Then '<<<
'Beep
Application.OnTime Sheets("Web").Range("AA2").Value, "CALL2", , False '<<<
End If
End Sub
Le righe marcate <<< vanno personalizzate con le stesse informazioni inserite in Sub CALL2
Credo che non avrai difficolta' a decodificare le modifiche introdotte.
Operativamente, quando il file viene aperto va inserito il contenuto in AA1 e poi va lanciata la Sub CALL2.
Se il sito risponde correttamente la Call2 viene rischedulata dopo 5 minuti, usando il metodo OnTime; se invece l'esito e' stato negativo il nuovo scheduling e' dopo 1 minuto.
Quando il file viene chiuso si procede a cancellare le schedulazioni gia' impostate.
La macro usa la cella AA2 del foglio Web per memorizzare l'ora del "prossimo" scheduling
Ciao