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.
non lo fare si blocca tuttoAnche a me non funziona, devo farlo manualmente...
Option Explicit
Sub Main
Dim nEstrInizio,nEstrFine
Dim DataIni,DataFin
Dim sFile
Dim sChrSep
Dim sDirDest
MsgBox "Sostituisci nello script la directory dove verrà creato il file csv" & vbCrLf & "Poi elimina questo messaggio",vbInformation
sDirDest = "C:\Users\****tuo computer*****\Desktop\SpazioLight\Archivio" '<========== modificare questa riga con il percorso della cartella archivio sul vostro pc
' sDirDest = GetDirectoryAppData
If DirectoryEsistente(sDirDest) Then
sChrSep = ";"
sFile = AddSlash(sDirDest) & "Lotto.csv"
If EliminaFile(sFile) Then
nEstrInizio = 1
nEstrFine = EstrazioniArchivio
Call EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep)
End If
Else
MsgBox "Directory non trovata" & vbCrLf & sDirDest
End If
End Sub
Sub EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep)
Dim k,f,idEstr
Dim sRecord
Dim nProgr
Dim sDataCorr
Dim r,e
For k = nEstrInizio To nEstrFine
Call Messaggio("Estrazione : " & k)
idEstr = k
ReDim aNum(0)
If GetEstrazioneCompleta(idEstr,aNum) Then
nProgr = nProgr + 1
sDataCorr = Replace(DataEstrazione(idEstr),".","/")
sRecord = FormatSpace(nProgr,9,True) & sChrSep
sRecord = sRecord & FormatSpace(IndiceAnnuale(idEstr),3,True) & sChrSep
sRecord = sRecord & sDataCorr & sChrSep
For r = 1 To 11
For e = 1 To 5
sRecord = sRecord & Format2(aNum(r,e)) & sChrSep
Next
Next
sRecord = RimuoviLastChr(sRecord,sChrSep)
Call ScriviFile(sFile,sRecord,False,True)
Else
Exit For
End If
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(nEstrInizio,nEstrFine,k)
Next
Call CloseFileHandle(sFile)
' Call LanciaFile(sFile)
Scrivi "Esportato file " & sFile
MsgBox "Fine",vbInformation
End Sub
Function AddSlash(s)
If Right(s,1) <> "\" Then
AddSlash = s & "\"
Else
AddSlash = s
End If
End Function
risolto ,grazie @Mike58 sempre top.Ciao , toon, Bogotà, Deve essere cambiata la pagina della lottomatica e monopoli.
Per ora l'aggiornamento è funzionante sempre da televideo, ma siccome possiamo non aggiornare frequentemente riscihamo di dover intervenire manualmente.
Per evitare il tutto con uno script lanciato da spaziometria possiamo aggiornare le colonne in formato csv per spaziolight.
Indicando il percorso della directory archivio.
in questa righa
sDirDest = "C:\Users\****tuo computer*****\Desktop\SpazioLight\Archivio" '<========== modificare questa riga con il percorso della cartella archivio sul vostro pc
script
Codice:Option Explicit Sub Main Dim nEstrInizio,nEstrFine Dim DataIni,DataFin Dim sFile Dim sChrSep Dim sDirDest MsgBox "Sostituisci nello script la directory dove verrà creato il file csv" & vbCrLf & "Poi elimina questo messaggio",vbInformation sDirDest = "C:\Users\****tuo computer*****\Desktop\SpazioLight\Archivio" '<========== modificare questa riga con il percorso della cartella archivio sul vostro pc ' sDirDest = GetDirectoryAppData If DirectoryEsistente(sDirDest) Then sChrSep = ";" sFile = AddSlash(sDirDest) & "Lotto.csv" If EliminaFile(sFile) Then nEstrInizio = 1 nEstrFine = EstrazioniArchivio Call EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep) End If Else MsgBox "Directory non trovata" & vbCrLf & sDirDest End If End Sub Sub EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep) Dim k,f,idEstr Dim sRecord Dim nProgr Dim sDataCorr Dim r,e For k = nEstrInizio To nEstrFine Call Messaggio("Estrazione : " & k) idEstr = k ReDim aNum(0) If GetEstrazioneCompleta(idEstr,aNum) Then nProgr = nProgr + 1 sDataCorr = Replace(DataEstrazione(idEstr),".","/") sRecord = FormatSpace(nProgr,9,True) & sChrSep sRecord = sRecord & FormatSpace(IndiceAnnuale(idEstr),3,True) & sChrSep sRecord = sRecord & sDataCorr & sChrSep For r = 1 To 11 For e = 1 To 5 sRecord = sRecord & Format2(aNum(r,e)) & sChrSep Next Next sRecord = RimuoviLastChr(sRecord,sChrSep) Call ScriviFile(sFile,sRecord,False,True) Else Exit For End If If ScriptInterrotto Then Exit For Call AvanzamentoElab(nEstrInizio,nEstrFine,k) Next Call CloseFileHandle(sFile) ' Call LanciaFile(sFile) Scrivi "Esportato file " & sFile MsgBox "Fine",vbInformation End Sub Function AddSlash(s) If Right(s,1) <> "\" Then AddSlash = s & "\" Else AddSlash = s End If End Function