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

[everest62]

appare la finestra e poi faccio ok

 

[Reacher]

Ed infatti dovrebbe aggiornarsi come ho fatto io
Hai connessione? Riapri e riprova

 

[everest62]

certo che ho connessione
sto scrivendo se non avevo connessione non scrivevo qui

 

[Reacher]

Sostituisci con questo

 

[everest62]

lo fatto ma non va
tu quale link hai per aggiornare forse devo cambiare il link

 

[Reacher]

Scarica il file
Elimina txt lasciando dat
Rimpiazza nella cartella di spaziometria
Questi i passaggi da seguire

 

[everest62]

dove devo eliminarlo
non hai lo script come ho fatto finora

 

[Reacher]

Non uso script
Se lo trovo qui lo posto
​

 

[everest62]

grazie

 

[Reacher]

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

 

[Alien.]

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.

 

[everest62]

ciao reacher io ho bisogno larchivio lotto tu mi hai dato il super enalotto

 

[Reacher]

ciao reacher io ho bisogno larchivio lotto tu mi hai dato il super enalotto

7.6 KB file on MEGA

mega.nz

Chissà perché ho letto ENALOTTO
Scarica e lancialo

 

[everest62]

e uno script

 

[Reacher]

506.51 MB folder on MEGA

75 files

mega.nz

 

[Reacher]

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.

Vedi l'allegato 2316145

506.51 MB folder on MEGA

75 files

mega.nz

elimina i dati enalotto e incoalla quelli che scarichi

 

[darta1964]

7.6 KB file on MEGA

mega.nz

Chissà perché ho letto ENALOTTO
Scarica e lancialo

Grazie Reacher per lo Script.Quello precedente (AGGIORNAMENTO ARCHIVIO LOTTO da LottoPython V.4.3.ls) sembra non funzionare più.Sarebbe bello "trovare" o creare uno Script per Aggiornare Le Estrazioni di WinForLife

 

[Reacher]

Winforlife non saprei...
Provo