Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
ciao Joe questo è archivio lotto giusto?
ciao joe, puoi per favore postare anche l'archivio BaseDatiSuperEna.dat corretto?
grazie
giovanni
Option Explicit
Sub Main
'Agg_Lotto V.4.3 By Joe *** Archivio LottoPython *** - 08/02/2026 -
'Script per Spaziometria By Joe.
Dim sFileLoc
Dim nEstrTot,sDataLastEstr,k,r
Dim sDataEstr,nNumEstr,nSalvate
Dim b
Dim sFileBd
Dim sLink
Dim Ia,N,sVV,x
Dim CfrData
Dim Vecchio,Nuovo
Dim V
Dim E
sLink = "https://raw.githubusercontent.com/Lottopython/exstrazionales/refs/heads/main/Estrazionales%20lotto.txt"
b = False : N = False
nSalvate = 0
sFileBd = GetDirectoryAppData & "BaseDati.dat"
Scrivi sFileBd,1,,,2 : Scrivi
sFileLoc = GetDirectoryAppData & "ArcTlv\"
Messaggio "Agg_Lotto V.4.3 By Joe *** Archivio LottoPython ***"
If CreaDirectory(sFileLoc) Then
sFileLoc = sFileLoc & "Archivio.txt"
If DownloadFromWeb(sLink,sFileLoc) Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
Vecchio = Right(sDataLastEstr,4)
Ia = IndiceAnnuale(nEstrTot)
If nEstrTot = 0 Then CfrData = "01/01/1871" : b = True : Ia = 0
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFileLoc,aRighe)
For k = 0 To UBound(aRighe) Step 12
AvanzamentoElab 1,UBound(aRighe),k
ReDim aV(0)
If Len(aRighe(k)) = 53 Then
sDataEstr = Left(aRighe(k),2) & "/" & Mid(aRighe(k),4,2) & "/" & Mid(aRighe(k),7,4)
ReDim aEstr(11,5)
For r = 0 To 10
sVV = Right(aRighe(k + r),27)
V = Split(sVV," ") '4 Spazi
For x = 0 To 4
aEstr(r + 1,x + 1) = V(x)
Next
Next
Nuovo = Right(sDataEstr,4)
If b Then
If Nuovo <> Vecchio Then Ia = 0 : Vecchio = Nuovo
If sDataEstr <> sDataLastEstr Then
Ia = Ia + 1
nNumEstr = Ia
If nNumEstr > 0 And IsDate(sDataEstr) Then
If CfrData <> sDataEstr Then
If SalvaEstrazione(aEstr,sDataEstr,nNumEstr,sFileBd) Then
CfrData = sDataEstr
nSalvate = nSalvate + 1
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ERRORE NELLE DATE",True
ColoreTesto 0
End If
End If
End If
End If
If sDataEstr = sDataLastEstr Then b = True
Else
Scrivi "Errore nel Download"
End If
Next
If nSalvate > 0 Then AllineaArchivi
Else
Scrivi "Errore nella creazione Dei File Necessari"
End If
Call Scrivi("Aggiornamento Lotto V.4.3 By Joe *** Utilizza Archivio lottoPython ***",1)
Call Scrivi("")
Call Scrivi("Estrazioni trovate in Archivio Remoto " & QuantitaEstrazioniInFile(sFileBd))
Call Scrivi("")
Call Scrivi("Archivio Locale Aggiornato all' Estrazione N° " & IndiceAnnuale(EstrazioniArchivio) & " del " & DataEstrazione(EstrazioneFin,,,"/"))
Call Scrivi("")
Call Scrivi("- Sono state Aggiunte " & nSalvate & " Estrazioni -",1,,,1)
Call Scrivi("")
End If
End Sub
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/Lottopython/SUPERENALOTTO-SPAZIOMETRIA/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
buonasera Joe ,senti per cortesia mi puoi aiutare ad aggiornare spaziometria sono rimasto all'ultima estrazione in data 29112025. ho provato con lo script ma mi da errore , per cortesia puoi aiutarmi ?? grazie Antonio .Questo script effettua il download dell' ARCHIVIO COMPLETO SUPERENALOTTO, che LottoPython ha reso disponibile su GitHub.
Codice: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/Lottopython/SUPERENALOTTO-SPAZIOMETRIA/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
PS: NON MODIFICA il numero-progressivo-estrazione che pertanto sostituisce l'indice annuale.
Aggiornamento Lotto V.4.3 By Joe *** Utilizza Archivio lottoPython ***
Estrazioni trovate in Archivio Remoto 10804
Archivio Locale Aggiornato all' Estrazione N° 25 del 14/02/2026
- Sono state Aggiunte 7 Estrazioni -

Sub Main
'Agg_Lottologia Script By Joe V.4.0 del 10/11/2025
Dim sDirTemp
Dim sLink
Dim nAnnoPart,nAnnoCorr,sNuovaData
Dim k
Dim id
Dim sDataEstr,sCData,nSalvate,sFileBd
Dim sV,r,e,x
Dim b,nEstrTot,sDataLastEstr,iA,z
nAnnoPart = Year(Now) - 1
nAnnoCorr = Year(Now)
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sDirTemp = GetDirectoryTemp & "lottologia.txt"
Call EliminaFile(sDirTemp)
For sNuovaData = nAnnoPart To nAnnoCorr
If ScriptInterrotto Then Exit For
Call Messaggio(sNuovaData)
Call AvanzamentoElab(nAnnoPart,nAnnoCorr,sNuovaData)
sLink = "https://www.lottologia.com/lotto/archivio-estrazioni/?as=TXT&year=" & sNuovaData
If DownloadFromWeb(sLink,sDirTemp) Then
nEstrTot = EstrazioniArchivio
If nEstrTot = 0 Then nAnnoPart = 1871 : b = True
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4)
id = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
If LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
If EliminaFile(sDirTemp) Then
If Trim(aRighe(k)) <> "" Then
For k = UBound(aRighe) - 3 To 2 Step - 1
aRighe(k) = Replace(aRighe(k),vbTab,"")
aRighe(k) = Replace(aRighe(k),"-","")
sDataEstr = Mid(aRighe(k),7,2) & "/" & Mid(aRighe(k),5,2) & "/" & Left(aRighe(k),4)
If z <> Left(aRighe(k),4) Then id = 0 : z = Left(aRighe(k),4)
sV = Right(aRighe(k),110)
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
aEstr(r,e) = Mid(sV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
If b = True Then
If sCData <> sDataEstr Then
id = id + 1
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
sCData = sDataEstr
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ESTRAZIONE DUPLICATA",True
ColoreTesto 0
End If
End If
If sDataEstr = sDataLastEstr Then b = True
'
Next
End If
End If
End If
End If
If ScriptInterrotto Then Exit For
Next
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria V.4.0 di LuigiB & Giomi Rev. By Joe",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("Utilizzato Archivio del sito www.lottologia.com")
Call Scrivi()
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",1,,,2)
End If
End Sub
Grazie, un salutoZac non penso dipenda esclusivamente dall'archivio.
Ci sono operazioni molto complesse che a volte richiedono molto tempo o quantità di memoria non disponibili.
![]()