joe
Advanced Member >PLATINUM PLUS<
Ho corretto alcuni bug ed implementato alcune nuove funzioni.
In particolare questa nuova versione permette di importare tutto l'archivio,
anche quando Spaziometria ha "perso" o è stato cancellato il suo.
Così pure permette di aggiungere molte estrazioni separando e numerando correttamente gli indici progressivi e annuali.
Ricordo che la versione 1.6.54 di Spaziometria è comunque autonoma nell'aggiornare il suo archivio Lotto.
Dunque questo script deve essere considerato un compendio ed una utility qualora ci fossero problemi,
con i siti o con le routine di aggiornamento del programma stesso o quando le vecchie versioni del programma
o del sistema operativo falliscono nel tentativo di aggiornamento.
Joe
P.S. Rendo esplicito il GRAZIE a SILOP che mantiene aggiornato l'archivio necessario allo script ed a tutti
coloro ne fruiscono gratuitamente.
In particolare questa nuova versione permette di importare tutto l'archivio,
anche quando Spaziometria ha "perso" o è stato cancellato il suo.
Così pure permette di aggiungere molte estrazioni separando e numerando correttamente gli indici progressivi e annuali.
Ricordo che la versione 1.6.54 di Spaziometria è comunque autonoma nell'aggiornare il suo archivio Lotto.
Dunque questo script deve essere considerato un compendio ed una utility qualora ci fossero problemi,
con i siti o con le routine di aggiornamento del programma stesso o quando le vecchie versioni del programma
o del sistema operativo falliscono nel tentativo di aggiornamento.
Codice:
Option Explicit
Sub Main
'Agg_Lotto V.4.3 By Joe *** Archivio Silop *** - 07/08/2025 -
'Script per Spaziometria By Joe.
Dim sFileLoc
Dim nEstrTot,sDataLastEstr,k,r,e
Dim sDataEstr,nNumEstr,nSalvate
Dim b
Dim sFileBd
Dim sLink
Dim Ia,N,sVV,x
Dim CfrData
Dim Vecchio,Nuovo
sLink = "https://www.silop.it/Archivio(televideo)/Archivio.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 Silop ***"
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)
AvanzamentoElab 1,UBound(aRighe),k
ReDim aV(0)
If Len(aRighe(k)) = 118 Then
sDataEstr = Left(aRighe(k),2) & "/" & Mid(aRighe(k),3,2) & "/" & Mid(aRighe(k),5,4)
sVV = Right(aRighe(k),110)
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
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
aEstr(r,e) = Mid(sVV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
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
End If
Next
If nSalvate > 0 Then AllineaArchivi
Else
MsgBox "Errore download verificare il link con il browser"
End If
Call Scrivi("Agg_Lotto V.4.2 By Joe *** Archivio Silop ***",1)
Call Scrivi("")
Call Scrivi("Estrazioni totali in Archivio " & QuantitaEstrazioniInFile(sFileBd))
Call Scrivi("")
Call Scrivi("Aggiornato all' Estrazione " & IndiceAnnuale(EstrazioniArchivio) & " del " & DataEstrazione(EstrazioneFin,,,"/"))
Call Scrivi("")
Call Scrivi(" - Aggiunte " & nSalvate & " Estrazioni -",1)
Call Scrivi("")
Call Scrivi("Sito Archivio " & Left(sLink,20))
Call Scrivi("")
End If
End SubP.S. Rendo esplicito il GRAZIE a SILOP che mantiene aggiornato l'archivio necessario allo script ed a tutti
coloro ne fruiscono gratuitamente.
Ultima modifica:
