Novità

Aggiornamento archivio lotto e superenalotto per SPAZIOMETRIA da spazio/web silop

Sub Main
'ARCHIVIO_SUPERENALOTTO x Spaziometria
'Script LuigiB-LottoPython-Joe V.4.3 del 12/02/2026
Dim sPercorsoLocale,sFileLocale
sPercorsoLocale = GetDirectoryTemp
CreaDirectory(sPercorsoLocale)
sFileLocale = sPercorsoLocale & "superenalotto_completo.csv"
Call EliminaFile(sFileLocale)
Dim sFileBaseDati : sFileBaseDati = GetDirectoryAppData & "BaseDatiSuperEna.Dat"
Dim eDate,eClock,sPercorsosFileBaseDatiBackup,sFileBaseDatiBackup
Call DateTimeTest(eDate) : Call ClockTimeTest(eClock)
sPercorsosFileBaseDatiBackup = GetDirectoryAppData & "Archivio SuperEnalotto\Backup\dat\"
CreaDirectory(sPercorsosFileBaseDatiBackup)
sFileBaseDatiBackup = sPercorsosFileBaseDatiBackup & "BaseDatiSuperEna.Dat.backup_Del_" & eDate & "_ore_" & eClock & ".bak"
If FileEsistente(sFileBaseDati) Then
Call CopiaFile(sFileBaseDati,sFileBaseDatiBackup)
End If
Dim sUrlCompleto,sScelta

sUrlCompleto = "https://raw.githubusercontent.com/L...PAZIOMETRIA/refs/heads/main/superenalotto.txt"
Call Messaggio("Scelto download da GitHub (predefinito).")

Dim StrMessInfo
StrMessInfo = MsgBox("Ricreare l'intero archivio dal 1997?" & vbCrLf & _
"Verranno eliminate tutte le estrazioni esistenti.",vbQuestion + vbYesNo,"Conferma Ricreazione")
If StrMessInfo = vbNo Then
MsgBox "Operazione annullata dall'utente.",vbInformation
Exit Sub
End If
Call EliminaFile(sFileBaseDati)
If Not DownloadFromWeb(sUrlCompleto,sFileLocale) Then
MsgBox "Errore nel download del file da:" & vbCrLf & sUrlCompleto,vbCritical,"Errore Download"
Exit Sub
End If
If Not FileEsistente(sFileLocale) Then
MsgBox "File temporaneo non trovato dopo il download.",vbCritical
Exit Sub
End If
Dim aRighe,k,sNumEstrTrovate
sNumEstrTrovate = 0
If LeggiRigheFileDiTesto(sFileLocale,aRighe) Then
For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For
Dim sRiga : sRiga = Trim(aRighe(k))
If sRiga <> "" Then
Dim aCampi : ReDim aCampi(0)
Call SplitByChar(sRiga,",",aCampi)
If UBound(aCampi) = 9 Then
Dim sID,sData
sID = Trim(aCampi(0))
sData = Trim(aCampi(1))
If Len(sData) = 10 And Mid(sData,3,1) = "/" And Mid(sData,6,1) = "/" Then
Dim nGiorno,nMese,nAnno
On Error Resume Next
nGiorno = Int(Split(sData,"/")(0))
nMese = Int(Split(sData,"/")(1))
nAnno = Int(Split(sData,"/")(2))
On Error GoTo 0
If nGiorno >= 1 And nGiorno <= 31 And _
nMese >= 1 And nMese <= 12 And _
nAnno >= 1997 And nAnno <= Year(Now) Then
Dim bValida : bValida = True
Dim i
For i = 2 To 9
Dim nValore
nValore = Int(Trim(aCampi(i)))
If nValore < 0 Or nValore > 90 Then
bValida = False
Exit For
End If
Next
If bValida Then
Dim aNumeri
ReDim aNumeri(8)
For i = 1 To 6
aNumeri(i) = Int(Trim(aCampi(i + 1)))
Next
aNumeri(7) = Int(Trim(aCampi(8)))
aNumeri(8) = Int(Trim(aCampi(9)))
Dim nID : nID = 0
On Error Resume Next
nID = CLng(sID)
On Error GoTo 0
Call SalvaEstrazioneSE(aNumeri,sData,nID,sFileBaseDati)
sNumEstrTrovate = sNumEstrTrovate + 1
If(sNumEstrTrovate Mod 500) = 0 Then
Call Messaggio("Estrazioni elaborate: " & sNumEstrTrovate)
End If
End If
End If
End If
End If
End If
Next
End If
Call EliminaFile(sFileLocale)
Call MsgBox("Aggiornamento completato con successo!" & vbCrLf & _
"Estrazioni totali importate: " & sNumEstrTrovate,vbInformation,"ARCHIVIO SUPERENALOTTO")
End Sub
Function DateTimeTest(eDate)
Dim DD,MM,YYYY : DD = Day(Now) : MM = Month(Now) : YYYY = Year(Now)
eDate = YYYY & Right("0" & MM,2) & Right("0" & DD,2)
End Function
Function ClockTimeTest(eClock)
Dim HH,MM,SS : HH = Hour(Now) : MM = Minute(Now) : SS = Second(Now)
eClock = Right("0" & HH,2) & Right("0" & MM,2) & Right("0" & SS,2)
End Function
 
Ciao Reacher ho fatto un pò di confusione funziona ma ripete gli anni varie volte dal 2019 al 2026 ovvio che poi gli script mi danno doppie, triple ecc. vincite.

1781105705022.png
 
Se hai ancora un pò di pazienza.


QUI HO BASE DATI DOPPI SUPERENALOTTO QUALE ELIMINO !
1781296482743.png


QUESTI LI DEVO CANCELLARE TUTTI ?


1781296648954.png
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 27 agosto 2026
    Bari
    29
    61
    70
    47
    10
    Cagliari
    46
    18
    58
    17
    81
    Firenze
    72
    11
    38
    28
    53
    Genova
    86
    79
    87
    55
    08
    Milano
    63
    31
    37
    45
    52
    Napoli
    01
    88
    30
    81
    60
    Palermo
    69
    36
    59
    75
    86
    Roma
    51
    12
    65
    66
    37
    Torino
    76
    62
    88
    75
    57
    Venezia
    02
    19
    69
    59
    14
    Nazionale
    46
    64
    58
    06
    36
    Estrazione Simbolotto
    Nazionale
    04
    09
    15
    10
    02

Ultimi Messaggi

Indietro
Alto