Altri sapranno aiutarti meglio di quanto non sia in grado di farlo io. Ho avuto lo stesso preblema, almeno 1000 volte e altrettante volte risolto, ma, ahimé! Non ricordo come, nulla di strano per uno che non ricorda neppure il suo nome.
Mi sembra d'aver visto, recentemente, Post sul tuo stesso problema.
Io utilizzo questo:
Vedi l'allegato 2296043
Ho questo Script del bravo Joe:
Option Explicit
Sub Main
Dim sFileLoc
Dim nEstrTot,sDataLastEstr,k,r,e,s
Dim sDataEstr,nNumEstr,nSalvate
Dim b
Dim sFileBd
Dim sLink
Dim Ia,N,sVV,x
Dim CfrData
'sLink = "
https://www.silop.it/Lotto_JGIO91/anno_2019.txt"
'sLink = "
https://www.silop.it/Lotto_JGIO91/Archivio.txt"
sLink = "
http://freetexthost.com/vweeomrskc"
b = False : N = False : s = " "
nSalvate = 0
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sFileLoc = GetDirectoryAppData & "temp\"
If CreaDirectory(sFileLoc) Then
sFileLoc = sFileLoc & "Estrazioni.txt"
If DownloadFromWeb(sLink,sFileLoc) Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
Ia = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFileLoc,aRighe)
For k = 0 To UBound(aRighe) 'To 0 Step - 1
ReDim aV(0)
Call SplitByChar(aRighe(k),s,aV)
'ColoreTesto 1 : Scrivi Len(aRighe(k)) : ColoreTesto 0
If Len(aRighe(k)) = 187 Then
'ColoreTesto 1 : Scrivi UBound(aV),0,0 : ColoreTesto 0
If UBound(aV) = 57 Then
sDataEstr =(aV(0))
' ColoreTesto 2 : Scrivi(sDataEstr),0,0 : ColoreTesto 0
' ColoreTesto 2 : Scrivi Len(aRighe(k)) : ColoreTesto 0
sVV = Mid(aRighe(k),11,165)
ColoreTesto 1 : Scrivi(sVV),0,0 : ColoreTesto 0
ColoreTesto 0 : Scrivi s & Right(aRighe(k),5)
' Scrivi ("<font name ='courier new' color = red size = 2>" & sDataEstr& "</font>" & "<font name ='courier new' color = blue size = 2>" & sVV & "</font>" )
If b Then
If N = False And(Right(sDataEstr,4) <> Right(sDataLastEstr,4)) Then Ia = 0 : N = True
If Left(sDataEstr,4) <> Left(sDataLastEstr,4) Then
Ia = Ia + 1
nNumEstr =(Ia)
'ColoreTesto 4 : Scrivi Ia : ColoreTesto 0
'ColoreTesto 1 : Scrivi sDataEstr : ColoreTesto 0
'ColoreTesto 2 : Scrivi sVV : ColoreTesto 0
If nNumEstr > 0 And IsDate(sDataEstr) Then
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 55 'Step 2
e = e + 1
'Scrivi Mid(sVV,x,2) & " ",0,0
aEstr(r,e) = aV(x)
If e = 5 Then r = r + 1 : e = 0 ': Scrivi
Next
'ScriviMatrice(aEstr)
If CfrData <> Left(sDataEstr,5) Then
If SalvaEstrazione(aEstr,sDataEstr,nNumEstr,sFileBd) Then
CfrData = Left(sDataEstr,5)
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ESTRAZIONE DUPLICATA",True
ColoreTesto 0
End If
End If
End If
End If
If sDataEstr = sDataLastEstr Then b = True
End If
End If
Next
If nSalvate > 0 Then Call Scrivi("") : AllineaArchivi
Else
MsgBox "Errore download verificare il link con il browser"
End If
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & QuantitaEstrazioniInFile(sFileBd))
Call Scrivi("")
Call Scrivi("Utilizzato archivio del sito " & Left(sLink,20))
Call Scrivi("")
'For k = 0 To UBound(aRighe)
'Call Scrivi(aRighe(k))
'Next
End If
End Sub
Sub ScriviRigaEstr(sData,sNumeri)
Scrivi("<font name ='courier new' color = red size = 2>" & sData & "</font>" & "<font name ='courier new' color = blue size = 2>" & sNumeri & "</font>")
End Sub
Prova, magari funziona
Ciao
Baciccia
Ho provato a scaricare il programma, ma temo di avere un problema...me lo scarica come "VLC", cosa sbaglio?
