Macro per importare dati dalla Lottomatica.

[nelson1331]

Ciao Anthony47.
Mi prendo il tempo necessario per fare i confronti uno ad uno, fra i dati che importavo precedentemente e quelli attuali.
Una volta che avro' la conferma della bonta' dei dati acquisiti, ti comunichero' qualcosa di piu' preciso, rispetto alle domande che hai formulato.
Se gli archivi saranno pressoche' identici, allora potrei tenere valida la base consistente acquisita ed aggiornare solo le ultime estrazioni.
A presto.

[nelson1331]

Ciao Anthony47.
Fino ad ora ho eseguito 3 comparazioni partendo dal 7.1.1939 e nessuna di esse e' coincidente.
Vi sono cioe' moltissimi errori nelle date ed ancora di piu' sui numeri estratti.
I confronti li ho eseguiti con il formato di oscar, con spaziometria e con archivioestrazionilotto.
L' unica carta vincente, per non ripetere gli stessi errori dei suddetti, e' quella di basarmi sugli archivi dello storico della Lottomatica a questo link : se vi sono errori anche su questo, non saprei a chi rivolgermi.
https://www.lotto-italia.it/lotto/estratti-ruote
Il formato delle estrazioni e' come da immagine.
https://1drv.ms/u/s!ApTdq9BQgwZZnUa59Mv5a0IaD5f7
A te chiedo : cosa mi consiglieresti, partendo da questo archivio di Lotto-Italia.It per avere su una sola riga, tutti gli estratti disposti in ordine di ruota ma, appartenenti alla medesima data ?
Cioe' si dovrebbe costruire una sola riga (per ogni data), che conterra' la data, il progressivo e gli eventuali 55 numeri degli estratti.
Grazie per eventuale risposta.
Nelson

[Anthony47]

Io di lotto ne capisco quanto di cricket, quindi non saprei quali siti raccomandare per l'archivio e le estrazioni. Quanto alla facilita' di recupero dell'ultima estrazione, lotto-italia.it e archivioestrazionilotto.it sono equivalenti; ma archivioestrazionilotto.it sembra meno peggio dell'altro per recuperare con calma e senza fretta qualche estrazione precedente.
Tuttavia mi chiedo perche' siamo qui, visto che il 27-07 scrivevo:

pertanto se parti da un archivio completo ma magari fermo al primo di giugno e poi usi la procedura per leggere da “lottoscar” e accodare sul tuo archivio solo le righe mancanti non dovresti avere un archivio complessivo completo?

E il codice per fare cio' l'avevo gia' pubblicato il 22-7

Che cosa non quadra in quanto fatto a luglio??
Ciao

[nelson1331]

Ciao Anthony47.
Non mi sono fatto sentire in questi giorni, perche' ho voluto crearmi un archivio di base, valido e potenzialmente senza errori.
Perche' ho fatto questo ? Per il semplice motivo, che quelli che fino ad ora mi offrivano il collegamento per aggiornare, non si sono mai preoccupati di verificare la bonta' e l' integrita' degli archivi. Vuol dire che una volta che ho generato l' archivio di base, l' ho comparato con altri 3 archivi dei quali sono a conoscenza (oscar, spaziometria ed 1 altro del quale posseggo gli archivi storici). Ebbene, solo facendo il confronto con quello di oscar sono uscite oltre 150 righe di errori o incompatibilita' (tanto dalle date sbagliate, quanto ai contenuti degli estratti) e percio' se devo costruire una casa, non voglio edificarla sui calcinacci. Percio' ho preso l' archivio zippato da questo sito : https://www.lotto-italia.it/lotto/estratti-ruote
Poi l' ho decompresso ed infine ho fatto tutti i passaggi per ricomporre l' archivio, nella modalita' di lettura che gia' conosci.
Percio' il mio archivio di base me lo sono costruito ed ho fiducia che sia valido e corretto.
Parte dalla data del 7.1.1939 e mi sono fermato al 9.8.2022 (6.575 estrazioni).
Percio' a questo punto dispongo di una base attendibile, sulla quale costruire i successivi aggiornamenti.
Se percio' puoi costruirmi la macro, che aggiorni automaticamente, dovrebbe prelevare i dati da : https://www.lotto-italia.it/lotto/estratti-ruote
La 1° colonna ("A"), sara' quella dedicata alla data.
La 2°colonna ("B"), conterra' un progressivo che parte da 1 con l' estrazione del 7.1.1939 e con l' ultima estrazione inserita ha il valore di 6.575. Mi va bene questa soluzione, poiche' posso fare all' interno dei fogli, le suddivisioni che mi serviranno per avere il numeratore collegato alle estrazioni mensili : 1° estrazione del mese, 2° estrazione del mese, 3° estrazione del mese ... ultima estrazione del mese e poi ricomincia daccapo al variare del mese).
I dati degli estratti : dovrebbero partire dalla colonna "C" e finire alla colonna "BE". (forma esatta)
Quindi avro' l' esigenza di aggiornare pochissime estrazioni a ritroso e se lo faro' ogni volta, si ridurra' anche il rischio degli errori.
Ti ho trasmesso tutto quello che ho fatto e se percio' riesci a crearmi una macro adatta, te ne sono grato.
Nelson

[Anthony47]

Quanto alla facilita' di recupero dell'ultima estrazione, lotto-italia.it e archivioestrazionilotto.it sono equivalenti; ma archivioestrazionilotto.it sembra meno peggio dell'altro per recuperare con calma e senza fretta qualche estrazione precedente.

Se percio' puoi costruirmi la macro, che aggiorni automaticamente, dovrebbe prelevare i dati da : https://www.lotto-italia.it/lotto/estratti-ruote
La 1° colonna ("A"), sara' quella dedicata alla data.

Ah, hai scelto il peggiore tra i due... Aspetta, qualcosa verra' fuori...

[Anthony47]

Quando sono andato a vedere come tirar fuori qualcosa lotto-italia.it per aggiornare l'archivio con le ultime estrazioni, dopo essermi messo le mani nei capelli per qualche minuto ho rispolverato la domanda che facevo qualche giorno fa:

Tuttavia mi chiedo perche' siamo qui, visto che il 27-07 scrivevo:

pertanto se parti da un archivio completo ma magari fermo al primo di giugno e poi usi la procedura per leggere da “lottoscar” e accodare sul tuo archivio solo le righe mancanti non dovresti avere un archivio complessivo completo?

E il codice per fare cio' l'avevo gia' pubblicato il 22-7

E ho riprovato: partendo da una archivio pre-esistente ma fermo a luglio ho lanciato l'aggiornamento.
La situazione prima:

La situazione dopo:

Mi pare un buon risultato, ed e' gia' disponibile
Tuttavia quel lavoro, nato a strati, e' relativamente lento perche' prima di aggiornare l'archivio con i soli nuovi risultati riformatta tutto l'archivio lottoscar. Ho modificato pertanto la parte che si occupa di riformattare, la Sub EXP, in modo da lavorare solo le ultime N estrazioni, dove N dipende dalla situazione dell'archivio corrente. In questo modo l'aggiornamento e' abbastanza rapido.

Il messaggio precedente di riferimento e': viewtopic.php?f=26&t=112510#p661434

Ritengo utile riportare qui il codice completo:

Codice: Seleziona tutto

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
        Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
        ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If


Sub Lottololast()
Dim ZipPath As String, Ret As Variant, mySplit
'
Sheets("ArchivioLS").Select
Range("A1:BE100000").ClearContents
'Scarica file .zip:
'
'>>>> PARTE MODIFICATA:
ZipPath = "C:\prova\"                       '<<< Una tua directory dove scaricare il file zippato
'
Ret = GetWebFile("http://lottoscar.altervista.org/ArchivioLotto.italia.zip", ZipPath)
If Ret = 0 Then
    MsgBox ("Import .zip fallito. Processo abortito")
Else
    Debug.Print "GetWebFile=" & Ret
End If
'
'Espandi .zip:
Call FileDeZip(Ret, ZipPath)
mySplit = Split("\ " & Ret, "\", , vbTextCompare)
'Apre archivio on-line:
Workbooks.Open ZipPath & "\" & "ArchivioLotto.italia.csv"
'<<<< Fine parte Modificata
'
'Copia e Scompattazione archivio
Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets("ArchivioLS").Range("A1")
ActiveWorkbook.Close False
Range("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 4)), TrailingMinusNumbers:=True
'
Call SortByData
'
Call EXP
'
Range("A1").Select
Selection.ColumnWidth = 13
Range("B1").Select
Selection.ColumnWidth = 5
Range("C1:BE1").Select
Selection.ColumnWidth = 3
'Inserisce colonna #estrazione
Columns("B:B").Insert Shift:=xlToRight
Columns("B:F").NumberFormat = "General"
Call FillColB(1)
Range("A1:B1") = Array("Data", "Indice")
'
Call LS_to_Archivio
'
'
'Msg finale
Sheets("Homepage").Select
MsgBox "Aggiornato archivio terminato ! ! !", vbInformation
End Sub


Sub FillColB(dummy)
'Popola colonna B
Dim wArr, BArr() As Integer, I As Long
Dim oMon As Integer, bCnt As Integer
'
wArr = Range(Range("A2"), Range("A2").End(xlDown)).Value
ReDim BArr(1 To UBound(wArr), 1 To 1)
For I = 1 To UBound(wArr)
    If Month(wArr(I, 1)) = oMon Then
        bCnt = bCnt + 1
    Else
        bCnt = 1
        oMon = Month(wArr(I, 1))
    End If
    BArr(I, 1) = bCnt
Next I
Range("B2").Resize(UBound(BArr), 1).Value = BArr
End Sub



 
Function GetWebFile(ByVal myUrl, ByVal myPath As String) As Variant
'byAnthony, ritorna Image Path & name OPPURE 0 se fail
Dim PathNName As String, URL As String
Dim mySplit, Resp As Long
mySplit = Split(myUrl, "/")
PathNName = myPath & mySplit(UBound(mySplit))
Resp = URLDownloadToFile(0, myUrl, PathNName, 0, 0)
If Resp = 0 Then
    GetWebFile = PathNName
    Exit Function
Else
    GetWebFile = 0
End If
End Function


Sub FileDeZip(ByVal fName As Variant, dzPath As Variant)
'Dim ZipFile As String, OutPath As String, ZipPath As String
'
Set sh = CreateObject("Shell.Application")
    sh.Namespace(dzPath & "").CopyHere sh.Namespace(fName).Items, 16          '16=Overwrite same name
Set sh = Nothing
End Sub


Sub EXP()
Dim myR, wArr, vInd As Long, cR As String
Dim oArr()
Dim I As Long, myMatch, J As Long, OldD As Date
Dim DeSh As Worksheet
'
myR = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RO", "TO", "VE", "NZ")
Set DeSh = ThisWorkbook.Sheets("ArchivioLS")
'
wArr = Range("A1").CurrentRegion
ReDim oArr(1 To UBound(wArr), 1 To (UBound(myR) + 1) * 5 + 1)
For I = 0 To UBound(myR)
    DeSh.Range("B1").Offset(0, I * 5).Resize(1, 5) = myR(I)
Next I
'Elabora solo il delta:
Dim LastD As Date
LastD = Sheets("Archivio").Cells(Rows.Count, 1).End(xlUp).Value
myMatch = Application.Match(CLng(LastD), DeSh.Range("A:A"), False)
If myMatch > (22 * 11) Then myMatch = myMatch - 20 * 11
'For I = 1 To UBound(wArr)
For I = myMatch To UBound(wArr)
    If wArr(I, 1) <> OldD Then
        vInd = vInd + 1
        OldD = wArr(I, 1)
        oArr(vInd, 1) = OldD
    End If
    cR = wArr(I, 2)
    myMatch = Application.Match(wArr(I, 2), DeSh.Range("A1").Resize(1, 60), False)
    If Not IsError(myMatch) Then
        For J = 0 To 4
            oArr(vInd, myMatch + J) = wArr(I, 3 + J)
        Next J
    End If
    DoEvents
Next I
Range("A:BG").Clear
DeSh.Range("A2").Resize(vInd, UBound(oArr, 2)).Value = oArr
End Sub

Sub SortByData()
'
    Columns("A:G").Select
    ActiveWorkbook.Worksheets("ArchivioLS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ArchivioLS").Sort.SortFields.Add2 Key:=Range( _
        "A1:A100000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ArchivioLS").Sort
        .SetRange Range("A1:G100000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub


Sub LS_to_Archivio()
Dim LS As Worksheet, ARCH As Worksheet
Dim LastD As Date, myMatch, lsDown As Long
'
Set LS = Sheets("ArchivioLS")
Set ARCH = Sheets("Archivio")
LastD = Application.WorksheetFunction.Max(ARCH.Range("A:A"))
myMatch = Application.Match(CLng(LastD), LS.Range("A:A"), False)
lsDown = LS.Cells(myMatch, 1).End(xlDown).Row
If lsDown < Rows.Count Then
    LS.Range(LS.Cells(myMatch, 1), LS.Cells(lsDown, 1)).Resize(, 58).Copy _
      Destination:=ARCH.Cells(Rows.Count, 1).End(xlUp)
    MsgBox ("Righe importate: " & (lsDown - myMatch))
Else
    MsgBox ("Non ci sono nuove righe da importare")
End If

End Sub


Va inserito in un modulo vba standard inizialmente vuoto, in modo che le dichiarazioni iniziali siano in testa al modulo, e all'occorrenza va eseguita la Sub Lottololast
Questa richiama altre subroutine:
- Function GetWebFile, si occupa di scaricare il file dal sito lottoscar.altervista.org
- Sub FileDeZip, per unzippare il file scaricato da lottoscar
- Sub SortByData, per ordinare per data crescente l'archivio scaricato
- Sub EXP, che si occupa di formattare l'archivio scaricato nel formato del tuo archivio
- Sub LS_to_Archivio, che si occupa di trasferire sull'Archivio il contenuto delle ultime estrazioni

Prova anche tu...

TestFile: [MULTI_C20721.xlsm]ArchivioLS

[nelson1331]

Ciao Anthony47,
Questa richiama altre subroutine:
- Function GetWebFile, si occupa di scaricare il file dal sito lottoscar.altervista.org
- Sub FileDeZip, per unzippare il file scaricato da lottoscar
- Sub SortByData, per ordinare per data crescente l'archivio scaricato
- Sub EXP, che si occupa di formattare l'archivio scaricato nel formato del tuo archivio
- Sub LS_to_Archivio, che si occupa di trasferire sull'Archivio il contenuto delle ultime estrazioni

Il punto critico e' questo : non bisogna piu' utilizzare nulla di lottoscar, poiche' gli archivi sono sballati (si rallegreranno gli stupidi che lo usano ancora). Ho trovato minimo 150 righe che non corrispondono a Lottomatica e percio' vuol dire che non si sono mai degnati di fare 1 solo controllo/verifica in 5 anni e percio' e' giusto che li abbandoni definitivamente.
Se percio' puoi costruirmi la macro, che aggiorni automaticamente, dovrebbe prelevare i dati esclusivamente da : https://www.lotto-italia.it/lotto/estratti-ruote
Il mio archivio, confrontando i dati della Lottomatica, me lo sono gia' costruito, ed e' quello del quale ti avevo accennato in precedenza.
E' sul mio archivio, che vorro' innestare la macro che mi costruirai.
La mia base, percio' e' e rimarra' solo quella che mi sono costruito.
Se ti serve il file excel che ho generato, dimmelo che lo mettero' a disposizione.
Grazie.
Nelson

[Anthony47]

Prendo per buono quello che dici...
Fortunatamente anche su lotto-italia.it posso procedere in un modo simile a quanto fatto su lottoscar; infatti su https://www.lotto-italia.it/lotto/estratti-ruote e' disponibile l'archivio delle estrazioni piu' recenti in formato .zip.
Pertanto, come fatto per lottoscar procedo come segue:
-scarico le estrazioni piu' recenti dal link di lotto-italia.it
-unzippo, formatto, prendo le ultime N estrazioni e le accodo in Archivio

Il tutto presuppone la presenza nel file excel di un foglio Archivio, in cui si aggiornera' l'archivio; di un foglio ArchivioLS, in cui si "lavoreranno" le estrazioni piu' recenti; un foglio Homepage (presente nel tuo file originale; non viene usato dalla macro ma viene selezionato al completamento).
Il codice complessivo:

Codice: Seleziona tutto

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
        Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
        ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If


Sub LottoloItalia()
Dim ZipPath As String, Ret As Variant, mySplit
'
Sheets("ArchivioLS").Select
Range("A1:BE100000").ClearContents
'Scarica file .zip:
'
'>>>> PARTE MODIFICATA:
ZipPath = "C:\prova\"                       '<<< Una tua directory dove scaricare il file zippato
'
Ret = GetWebFile("https://www.igt.it/STORICO_ESTRAZIONI_LOTTO/storico01-oggi.zip", ZipPath)
If Ret = 0 Then
    MsgBox ("Import .zip fallito. Processo abortito")
Else
    Debug.Print "GetWebFile=" & Ret
End If
'
'Espandi .zip:
Call FileDeZip(Ret, ZipPath)
mySplit = Split("\ " & Ret, "\", , vbTextCompare)
'Importa storico
Call TxtImporta(ZipPath & "storico01-oggi.txt")

Call SortByData
'
Call EXP(1)
'
Range("A1").Select
Selection.ColumnWidth = 13
Range("B1").Select
Selection.ColumnWidth = 5
Range("C1:BE1").Select
Selection.ColumnWidth = 3
'Inserisce colonna #estrazione
Columns("B:B").Insert Shift:=xlToRight
Columns("B:F").NumberFormat = "General"
Call FillColB(1)
Range("A1:B1") = Array("Data", "Indice")
'
Call LS_to_Archivio(1)
'
'
'Msg finale
Sheets("Homepage").Select
MsgBox "Aggiornato archivio terminato ! ! !", vbInformation
End Sub


Sub FillColB(Dummy)
'Popola colonna B
Dim wArr, BArr() As Integer, I As Long
Dim oMon As Integer, bCnt As Integer
'
wArr = Range(Range("A2"), Range("A2").End(xlDown)).Value
ReDim BArr(1 To UBound(wArr), 1 To 1)
For I = 1 To UBound(wArr)
    If Month(wArr(I, 1)) = oMon Then
        bCnt = bCnt + 1
    Else
        bCnt = 1
        oMon = Month(wArr(I, 1))
    End If
    BArr(I, 1) = bCnt
Next I
Range("B2").Resize(UBound(BArr), 1).Value = BArr
End Sub



 
Function GetWebFile(ByVal myUrl, ByVal myPath As String) As Variant
'byAnthony, ritorna Image Path & name OPPURE 0 se fail
Dim PathNName As String, URL As String
Dim mySplit, Resp As Long
mySplit = Split(myUrl, "/")
PathNName = myPath & mySplit(UBound(mySplit))
Resp = URLDownloadToFile(0, myUrl, PathNName, 0, 0)
If Resp = 0 Then
    GetWebFile = PathNName
    Exit Function
Else
    GetWebFile = 0
End If
End Function


Sub FileDeZip(ByVal fName As Variant, dzPath As Variant)
'Dim ZipFile As String, OutPath As String, ZipPath As String
'
Set sh = CreateObject("Shell.Application")
    sh.Namespace(dzPath & "").CopyHere sh.Namespace(fName).Items, 16          '16=Overwrite same name
Set sh = Nothing
End Sub


Sub EXP(ByVal Dummy)
Dim myR, wArr, vInd As Long, cR As String
Dim oArr()
Dim I As Long, myMatch, J As Long, OldD As Date
Dim DeSh As Worksheet
'
myR = Array("BA", "CA", "FI", "GE", "MI", "NA", "PA", "RM", "TO", "VE", "RN")
Set DeSh = ThisWorkbook.Sheets("ArchivioLS")
'
DeSh.Select
wArr = Range("A1").CurrentRegion
ReDim oArr(1 To UBound(wArr), 1 To (UBound(myR) + 1) * 5 + 1)
For I = 0 To UBound(myR)
    DeSh.Range("B1").Offset(0, I * 5).Resize(1, 5) = myR(I)
Next I
'Elabora solo il delta:
Dim LastD As Date
LastD = Sheets("Archivio").Cells(Rows.Count, 1).End(xlUp).Value
myMatch = Application.Match(CLng(LastD), DeSh.Range("A:A"), False)
If myMatch > (22 * 11) Then myMatch = myMatch - 20 * 11
'For I = 1 To UBound(wArr)
For I = myMatch To UBound(wArr)
    If wArr(I, 1) <> OldD Then
        vInd = vInd + 1
        OldD = wArr(I, 1)
        oArr(vInd, 1) = OldD
    End If
    cR = wArr(I, 2)
    myMatch = Application.Match(wArr(I, 2), DeSh.Range("A1").Resize(1, 60), False)
    If Not IsError(myMatch) Then
        For J = 0 To 4
            oArr(vInd, myMatch + J) = wArr(I, 3 + J)
        Next J
    End If
    DoEvents
Next I
Range("A2:BG100000").Clear
DeSh.Range("A2").Resize(vInd, UBound(oArr, 2)).Value = oArr
End Sub

Sub SortByData()
'
    Columns("A:G").Select
    ActiveWorkbook.Worksheets("ArchivioLS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ArchivioLS").Sort.SortFields.Add2 Key:=Range( _
        "A1:A100000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ArchivioLS").Sort
        .SetRange Range("A1:G100000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub


Sub LS_to_Archivio(ByVal Dummy)
Dim LS As Worksheet, ARCH As Worksheet
Dim LastD As Date, myMatch, lsDown As Long
'
Set LS = Sheets("ArchivioLS")
Set ARCH = Sheets("Archivio")
LastD = Application.WorksheetFunction.Max(ARCH.Range("A:A"))
myMatch = Application.Match(CLng(LastD), LS.Range("A:A"), False)
lsDown = LS.Cells(myMatch, 1).End(xlDown).Row
If lsDown < Rows.Count Then
    LS.Range(LS.Cells(myMatch, 1), LS.Cells(lsDown, 1)).Resize(, 58).Copy _
      Destination:=ARCH.Cells(Rows.Count, 1).End(xlUp)
    MsgBox ("Righe importate: " & (lsDown - myMatch))
Else
    MsgBox ("Non ci sono nuove righe da importare")
End If

End Sub

Sub TxtImporta(ByVal TXTFile As String)
'
Sheets("ArchivioLS").Select
On Error Resume Next
Range("A1").QueryTable.Delete
On Error GoTo 0
'
    Range("A:BG").Clear
    Range("A1").Select
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & TXTFile, Destination:=Range("$A$1"))
        .Name = "storico01-oggi"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub



Va messo in un nuovo modulo vba standard, inizialmente vuoto, e all'occorrenza va lanciata la Sub LottoloItalia

Ci sono tutte le subroutine precedenti con le funzionalita' descritte nel messaggio precedente, piu' una Sub TxtImporta che si occupa di importare in ArchivioLS le ultime estrazioni.
Come nelle proposte precedenti, nella macro va dichiarata una directory al cui interno sara' scaricato il file .zip delle estrazioni piu' recenti, il cui contenuto sara' decompresso (unzipped) e salvato nella stessa directory. Al momento io ho dichiarato C:\Prova\ (non dimenticare la \ finale)

Prova...

TestFile: \[MULTI_C20721.xlsm]ArchivioLS

[nelson1331]

Ciao Anthony47.
La creazione del file ArchivioLs e' ok.
Il problema che vedrai nella 2° immagine, e' il sort su di esso.
Di conseguenza archivio, non e' stato aggiornato con le estrazioni mancanti.
https://1drv.ms/u/s!ApTdq9BQgwZZnUzISXcHlMk7bGfw
https://1drv.ms/u/s!ApTdq9BQgwZZnU2CTtPI54p4y7UJ

[Anthony47]

Cioe' che succede? C'e' un errore su quella istruzione?
La Sub SortByData e' da parecchio che te la propongo; in passato, sulle altre soluzioni, ti aveva funzionato o non hai mai provato?
Mi ricordi la versione Office che usi
Intanto prova a usare ".Add" invece che ".Add2"

Ciao

[nelson1331]

Excel 2010

[nelson1331]

Excel 2010
Con la modifica Add anziche' Add2, funziona.
Grazie Anthony47.
Buona giornata.
Nelson

[nelson1331]

Ciao Anthony47,
ti aggiungo 2 immagini (perche' le immagini sono piu' eloquenti delle parole) ed una nota finale.
Immagine pre aggiornamento :
https://1drv.ms/u/s!ApTdq9BQgwZZnU5tGDIocamZl4QM
Immagine post aggiornamento :
https://1drv.ms/u/s!ApTdq9BQgwZZnU-KfLKwd6tNAX5f
Nota : va tutto bene e cosi' posso utilizzarlo al meglio.
Potranno cosi' fruirne altri che vogliono aggiornare questi dati.
L' unica nota che voglio segnalarti e' questa (comunque non cambia i risultati e pertanto se non vi e' soluzione, cosi' va piu' che bene).
Se noti fra l'immagine pre aggiornamenti e post aggiornamenti, vedrai che l' estrazione del 9.8.2022 viene ripresa e sovrascritta (lo noti dal carattere dell' editor).
Cioe' in pratica, nell' archivio, va a riscriversi l' ultima estrazione preesistente.
Se c' e' una soluzione, bene, altrimenti quanto fatto mi soddisfa pienamente.
Ancora grazie.
Nelson