Novità

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

Scarica il file
Elimina txt lasciando dat
Rimpiazza nella cartella di spaziometria
Questi i passaggi da seguire
 
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
    sabato 20 giugno 2026
    Bari
    90
    24
    74
    14
    75
    Cagliari
    79
    37
    32
    44
    27
    Firenze
    07
    56
    79
    29
    44
    Genova
    17
    24
    43
    89
    22
    Milano
    69
    51
    28
    27
    70
    Napoli
    08
    75
    73
    35
    22
    Palermo
    58
    42
    78
    59
    09
    Roma
    88
    78
    84
    68
    53
    Torino
    61
    34
    65
    59
    27
    Venezia
    37
    23
    76
    89
    86
    Nazionale
    72
    18
    63
    22
    33
    Estrazione Simbolotto
    Napoli
    22
    29
    25
    24
    43
Indietro
Alto