| Ciao a tutti, ferma restante la mia temporanea condizione di stand-by per lo sviluppo del codice Lottoopen fornito da Luigi (fortunatamente è tornato il lavoro e non posso proprio sottrarmi!), ho ricevuto una mail con quanto segue. Mi è strato girato questo listato: Option Explicit
'https://forum.lottoced.com/threads/aggiornamento-estrazioni-lotto-spaziometria-1-6-31.2194296/post-2238089
'script di Mike58
' PRIMA di lanciare lo script accertarsi che l'estrazione si vede a video
'nella pagina del TELEVIDEO RAI qui :
'http://www.televideo.rai.it/televideo/pub/solotesto.jsp?regione=&pagina=786&sottopagina=01
'Attenzione la barra potrebbe non risultare aggiornata ma basta spostarla per vederla aggiornata, Mike58.
Sub Main()
Dim sLink
Dim sFileLocal
Dim aRighe,aRigheTmp
Dim aNumRuota(11,5)
Dim nIdRuota
Dim k,r
Dim nRuoteLette
Dim sData
Dim sDataLastEstr
Dim sTesto
Dim nLastIndiceAnn,nNewIndiceAnn
Dim sFileDati
sFileDati = GetDirectoryAppData & "BaseDati.dat"
MsgBox " Ultima è la pagina 786 TLV " ' silop
MsgBox " PenUltima è la pagina 787 TLV " ' silop
Select Case ScegliEstrazione
Case 0
sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=786"
Case 1
sLink = "http://www.televideo.rai.it/televideo/pub/solotesto.jsp?pagina=787"
End Select
nIdRuota = 0
nRuoteLette = 0
sDataLastEstr = DataEstrazione(EstrazioniArchivio,,,"/")
nLastIndiceAnn = IndiceAnnuale(EstrazioniArchivio)
sFileLocal = GetDirectoryAppData & "temp\Estrazione.htm"
If DownloadFromWeb(sLink,sFileLocal) Then
Call LeggiRigheFileDiTesto(sFileLocal,aRighe)
For k = 0 To UBound(aRighe)
If InStr(aRighe(k),"ESTRAZIONE DEL") Then
aRigheTmp = Split(aRighe(k),vbLf)
For r = 0 To UBound(aRigheTmp)
nIdRuota = IdRigaRuota(aRigheTmp(r))
If nIdRuota > 0 Then
If LeggiNumRuota(aRigheTmp(r),aNumRuota,nIdRuota) Then
nRuoteLette = nRuoteLette + 1
End If
Else
If IsDate(Trim(aRigheTmp(r))) Then
sData = Trim(aRigheTmp(r))
End If
End If
If nRuoteLette = 11 Then Exit For
Next
Exit For
End If
Next
If nRuoteLette = 11 Then
If sData = sDataLastEstr Then
MsgBox "Non ci sono estrazioni da scaricare",vbInformation
Else
sTesto = "Ultima estrazione presente " & FormattaStringa(sDataLastEstr,"Long Date") & vbCrLf
sTesto = sTesto & "Estrazione scaricata " & FormattaStringa(sData,"Long Date") & vbCrLf & vbCrLf
sTesto = sTesto & "Aggiungere l'estrazione del " & FormattaStringa(sData,"Long Date") & " ?" & vbCrLf & vbCrLf
sTesto = sTesto & GetAnteprimaNumeri(aNumRuota)
If MsgBox(sTesto,vbQuestion + vbYesNo) = vbYes Then
If Year(sData) = Year(sDataLastEstr) Then
nNewIndiceAnn = nLastIndiceAnn + 1
Else
nNewIndiceAnn = 1
End If
If SalvaEstrazione(aNumRuota,sData,nNewIndiceAnn,sFileDati) Then
MsgBox "Aggiornamento effettuato",vbInformation
Else
MsgBox "Errore aggiornamento",vbCritical
End If
End If
End If
End If
End If
Scrivi "EstrazioneFine in Archivio : " &(sDataLastEstr),1
Scrivi " Attenzione la barra potrebbe non risultare aggiornata all'estrazione successiva "
Scrivi " ma basta cliccare sulla BARRA SOTTO freccia >| per vederla aggiornata, Mike58/silop. "
End Sub
Function IdRigaRuota(sRiga)
Dim aRuote
Dim k
Dim nRet
nRet = 0
aRuote = Array("","Bari","Cagliari","Firenze","Genova","Milano","Napoli","Palermo","Roma","Torino","Venezia","Nazionale")
For k = 1 To UBound(aRuote)
If InStr(1,sRiga,aRuote(k),vbTextCompare) Then
nRet = k
Exit For
End If
Next
IdRigaRuota = nRet
End Function
Function LeggiNumRuota(sRiga,aNumRuota,nIdRuota)
Dim aV
Dim k
Dim nQNum
nQNum = 0
sRiga = Replace(sRiga,vbTab,"")
sRiga = Trim(RiduciSpazi(sRiga))
aV = Split(sRiga," ")
If UBound(aV) = 5 Then
For k = 1 To 5
If IsNumeric(aV(k)) Then
aNumRuota(nIdRuota,k) = aV(k)
nQNum = nQNum + 1
End If
Next
LeggiNumRuota =(nQNum = 5)
Else
LeggiNumRuota = False
End If
End Function
Function RiduciSpazi(s)
Dim sTmp
sTmp = s
Do While InStr(sTmp," ")
sTmp = Replace(sTmp," "," ")
Loop
RiduciSpazi = sTmp
End Function
Function GetAnteprimaNumeri(aNumRuota)
Dim r,e,sRet
For r = 1 To 11
sRet = sRet & NomeRuota(Iif(r <= 10,r,12)) & " "
For e = 1 To 5
sRet = sRet & FormatSpace(aNumRuota(r,e),2,True) & " "
Next
sRet = Trim(sRet) & vbCrLf
Next
GetAnteprimaNumeri = sRet
End Function
Function ScegliEstrazione
Dim aVoci
Dim r
aVoci = Array("Ultima","Penultima")
r = ScegliOpzioneMenu(aVoci,0,"Aggiornamento da televideo")
ScegliEstrazione = r
End Function Il listato, sviluppato da Mike58, permette di aggiornare le estrazioni di Spaziometria prendendo i dati dalla pagina di televideo. Forse può tornare utile a chi incontra qualche problema sul tema. L'unica cosa, e qui chiedo lumi a chi ne sa, ci sono due punti "delicati": 1) (riportato anche dall'autore): 'Attenzione la barra potrebbe non risultare aggiornata ma basta spostarla per vederla aggiornata, Mike58.' 2) Una volta aggiornato l'archivio, gli archivi Paralleli non risultano aggiornati ma bisogna procedere da menu "Base Dati" --> "Archivi paralleli per posizione" --> selezionare 1-2-3-4 o 5 (per aggiornare gli archivi posizioni) --> Esegui Vi torna tutto? Saluti |
