' 2.0.0
' Nuova versione per supportare il nuovo formato JSON della guida SKY
' 1.1.2
'Aggiunto scaricamento automatico eventi con nome troppo corto nella "tabella rapida"
'Bisogna riaggiungere il conteggio corretto della versione 1.1.1
' 1.1.0:
' Tolta sostituzione virgolette con apici (faccio il contrario, metto virgolette nei pattern)
' Spostata definizione pattern fuori dal ciclo.
' Ridotti da 1 a 3 in ciclo: InStr(InStr(orario, " ") + 1, orario, " ")
' Eliminata dal tutto riformattazione file (perfettamente inutile).
' ************** Richiede MICROSOFT JTML OBJECT LIBRARY:
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
'Dim riga As Long
Dim Progress As String
Dim abort As Boolean
Dim expr(20), M(20) As String
Dim numex As Integer
Dim pattern(5) As String
Dim NumEventi As Long
Dim NumeroEventiSelezionati As Long
Public NumeroGeneri As Integer
Public genere(20) As String
Dim ricerca As String
Const COLONNA_BASE = 4
Const COLONNA_ID = 1
Const COLONNA_ORARIO = 3
Const COLONNA_DURATA = 4
Const COLONNA_TITOLO = 5
Const COLONNA_TRAMA = 7
Const STRINGA_GENERE = "http://guidatv.sky.it/app/guidatv/contenuti/data/grid/grid_GGGGGGGG_channels.js"
Const STRINGA_CANALE = "http://guidatv.sky.it/app/guidatv/contenuti/data/grid/AA_MM_GG/ch_CCCCCCCC.js"
Const STRINGA_EVENTO = "http://guidatv.sky.it/EpgBackend/event_description.do?eid=EEEEEEEE"
Sub InitVars()
genere(1) = "intrattenimento"
genere(2) = "cinema"
genere(3) = "sport"
genere(4) = "mondi"
genere(5) = "news"
genere(6) = "bambini"
genere(7) = "primafila"
genere(8) = "hd"
genere(9) = "musica"
NumeroGeneri = 9
End Sub
Private Sub Scarica(percorso, id, riga)
' Scarica file XML dell'evento specificato, estraendone i dati (canale, ora, trama,...)
' e scrivendoli in tabella a partire dalla riga specificata.
Dim inizio, fine As Integer
Dim Regex As RegExp
Dim matches As MatchCollection
Dim Ma As Match
Dim cc As Range
'On Error GoTo errlabel::
StrUrl = "http://www.skylife.it/static/epg/timeline/data/" + percorso + "/" + id + ".xml"
If Dir("C:\temp", vbDirectory) = "" Then MkDir ("c:\temp")
nomefile = "c:\temp\palsky-sing-temp.xml" ' UPGRADE
errcode = URLDownloadToFile(0, StrUrl, nomefile, 0, 0)
If errcode = 0 Then
'Debug.Print "Palinsesti scaricati"
Else
frmSetup.txtStatus = "Errore scaricando i dati dell'evento " & id
End If
Open nomefile For Input As #2
loadtextfile = Input$(LOF(2), 2)
'LoadTextFIle = Replace(LoadTextFIle, Chr$(34), "'")
Close #2
Set Regex = New RegExp ' Create a regular expression.
Regex.pattern = pattern(1) '"<div class=popupcanale'>"
Regex.IgnoreCase = False ' Set case insensitivity.
Regex.Global = True ' Set global applicability.
Set matches = Regex.Execute(loadtextfile) ' Execute search.
inizio = matches(0).FirstIndex + matches(0).Length + 1
fine = InStr(inizio, loadtextfile, "<div")
lung = fine - inizio - 6
canale = Mid$(loadtextfile, inizio, lung)
Set Regex = New RegExp ' Create a regular expression.
Regex.pattern = pattern(2) ' "<div class='popuporario'>"
' Regex.IgnoreCase = False ' Set case insensitivity.
' Regex.Global = True ' Set global applicability.
Set matches = Regex.Execute(loadtextfile) ' Execute search.
inizio = matches(0).FirstIndex + matches(0).Length + 1
fine = InStr(inizio, loadtextfile, "<div")
lung = fine - inizio - 6
orario = Mid$(loadtextfile, inizio, lung)
Set Regex = New RegExp ' Create a regular expression.
Regex.pattern = pattern(3) ' "<div class='popupgenere'>"
' Regex.IgnoreCase = False ' Set case insensitivity.
' Regex.Global = True ' Set global applicability.
Set matches = Regex.Execute(loadtextfile) ' Execute search.
inizio = matches(0).FirstIndex + matches(0).Length + 1
fine = InStr(inizio, loadtextfile, "<div")
lung = fine - inizio - 6
genere = Mid$(loadtextfile, inizio, lung)
Set Regex = New RegExp ' Create a regular expression.
Regex.pattern = pattern(4) ' "<div class='popuptitle'>"
' Regex.IgnoreCase = False ' Set case insensitivity.
' Regex.Global = True ' Set global applicability.
Set matches = Regex.Execute(loadtextfile) ' Execute search.
inizio = matches(0).FirstIndex + matches(0).Length + 1
fine = InStr(inizio, loadtextfile, "<div")
lung = fine - inizio - 6
titolo = Mid$(loadtextfile, inizio, lung)
Set Regex = New RegExp ' Create a regular expression.
Regex.pattern = pattern(5) ' "<div class='testo'>"
' Regex.IgnoreCase = False ' Set case insensitivity.
' Regex.Global = True ' Set global applicability.
Set matches = Regex.Execute(loadtextfile) ' Execute search.
inizio = matches(0).FirstIndex + matches(0).Length + 1
fine = InStr(inizio, loadtextfile, "</div")
lung = fine - inizio - 0
trama = Mid$(loadtextfile, inizio, lung)
InizioOrario = InStr(InStr(orario, " ") + 1, orario, " ")
orario = Replace(orario, "ì", "i'")
Cells(riga, 1) = canale
Cells(riga, 2) = Mid$(orario, 1, InizioOrario)
Cells(riga, 3) = Replace$(Mid$(orario, InizioOrario + 7, Len(orario) - InizioOrario + 1), ".", ":")
'Cells(riga, 8) = orario
Cells(riga, 4) = genere
Cells(riga, 5) = titolo
Cells(riga, 6) = trama
Cells(riga, 7) = "http://guidatv.sky.it/guida_tv/evdetail.do?id=" & id
Cells(riga, 7).Select
Cells(riga, 7).Hyperlinks.Add Anchor:=Selection, Address:="http://guidatv.sky.it/guida_tv/evdetail.do?id=" & id, TextToDisplay:="link"
DoEvents
GoTo oklabel::
errlabel::
MsgBox ("Errore '" & Err.Description & "' in 'Scarica(" & percorso & "," & id & "," & Str(riga) & "')")
Stop
oklabel::
End Sub
Function Elabora(gen As String, giorno As Integer, riga) As Long
' Macro per elaborare file XML dei palinsesti SKY,
' scaricati dall'indirizzo:
' http://www.skylife.it/static/epg/timeline/data/cinema_7.xml
' Il numero finale indica i giorni (1=oggi, max 7)
Dim Regex As RegExp
Dim matches As MatchCollection
Dim Ma As Match
Dim InizioReq, FineReq As Long
Dim ReqNum, ReqCont As String
Dim id, percorso As String
Dim StartDay As Integer
Const MAXDAYS = 7
Dim ChanNamePos(1000) As Long
Dim ChanName(1000) As String
Dim qchan As Integer
Dim NumChannels As Integer
Dim ws As Worksheet
abort = False
'On Error GoTo errlabel::
'Call InizializzaFoglio
Worksheets(1).Hyperlinks.Delete
Worksheets(2).Hyperlinks.Delete
frmSetup.txtStatus.Caption = "Inizializzazione...": DoEvents
' Scarica palinsesto principale contenente i vari "ID" dei singoli eventi:
StrUrl = "http://www.skylife.it/static/epg/timeline/data/" & gen & "_" & RTrim$(LTrim$(Str(giorno))) & ".xml"
nomefile = "c:\temp\palsky-all-temp.xml"
frmSetup.txtStatus.Caption = "Connessione al server per scaricamento giorno " & Str(giorno): DoEvents
errcode = URLDownloadToFile(0, StrUrl, nomefile, 0, 0)
If errcode <> 0 Then
frmSetup.txtStatus = "Errore n. 0x" & Hex(errcode) & " su " & StrUrl
Else
frmSetup.txtStatus.Caption = "Giorno scaricato. Elaborazione...": DoEvents
frmSetup.txtStatus.Caption = "Elaborazione... Carico file in memoria.": DoEvents
Open nomefile For Input As #3
Contents = Input$(LOF(3), 3)
'Contents = Replace(Contents, Chr$(34), "'")
Close #3
frmSetup.txtStatus.Caption = "Elaborazione... Formatto dati...": DoEvents
' Contents = Replace(Contents, Chr$(34), "'") 'Sostituisce virgolette con apici.
frmSetup.txtStatus.Caption = "Elaborazione... Formatto dati... Fase 1 completata": DoEvents
Set Regex = New RegExp
Regex.pattern = " class=" & Chr$(34) & "canale" & Chr$(34)
Regex.IgnoreCase = False
Regex.Global = True
Set matches = Regex.Execute(Contents)
NumChannels = matches.Count ' Salta definizioni canali
Set Regex = New RegExp
Regex.pattern = "<div channelId="
Regex.IgnoreCase = False
Regex.Global = True
Set matches = Regex.Execute(Contents)
For qchan = NumChannels To matches.Count - 1
ChanNamePos(qchan) = matches(qchan).FirstIndex + 17
ChanName(qchan) = Mid$(Contents, ChanNamePos(qchan), InStr(ChanNamePos(qchan), Contents, Chr$(34)) - ChanNamePos(qchan))
Next
Set Regex = New RegExp
' UPGRADE:
Regex.pattern = Chr$(34) & "\d\d\d\d\d\d\d\d" & Chr$(34) ' Individua singoli eventi per scaricare file xml relativi.
Regex.IgnoreCase = False
Regex.Global = True
Set matches = Regex.Execute(Contents)
dayevents = 0
frmSetup.txtStatus.Caption = "Elaborazione... Ricerca eventi...": DoEvents
CurChan = NumChannels
For Each Ma In matches
If Ma.FirstIndex > ChanNamePos(CurChan + 1) Then CurChan = CurChan + 1
'For matchind = 0 To matches.Count
riga = riga + 1
dayevents = dayevents + 1
id = Mid$(Contents, Ma.FirstIndex + 1 + 1, 8) ' UPGRADE
percorso = Mid$(Contents, Ma.FirstIndex + 11 + 7, 5) ' UPGRADE
minititolo = Mid$(Contents, Ma.FirstIndex + 11 + 7 + 7, InStr(Ma.FirstIndex + 11 + 7 + 7, Contents, "</a>") - (Ma.FirstIndex + 11 + 7 + 7)) ' UPGRADE
'id = Mid$(Contents, matches(matchind).FirstIndex + 1 + 1, 8) ' UPGRADE
'percorso = Mid$(Contents, matches(matchind).FirstIndex + 11 + 7, 5) ' UPGRADE
'minititolo = Mid$(Contents, matches(matchind).FirstIndex + 11 + 7 + 7, InStr(matches(matchind).FirstIndex + 11 + 7 + 7, Contents, "</a>") - (matches(matchind).FirstIndex + 11 + 7 + 7)) ' UPGRADE
frmSetup.txtStatus.Caption = "Elaborazione '" & gen & "'... Estrazione dati evento" & Str(dayevents) & "/" & LTrim(Str$(matches.Count)) & " giorno" & Str(giorno) & "/" & LTrim(Str$(MAXDAYS)) & " (" & LTrim(Str$(Int(dayevents * 100 / matches.Count))) & "%)...": DoEvents
If Cells(1, 2) = "x" Then ' Se c'e' la X, scarica dettagli trama.
Call Scarica(percorso, id, riga)
Else ' Altrimenti scrive solo il link.
' Worksheets(2).Range("E" & LTrim$(riga)).Select
' With Worksheets(2)
' .Hyperlinks.Add .Range("E" & LTrim$(riga)), "http://www.skylife.it/static/epg/timeline/data/" + percorso + "/" + id + ".xml"
' ' Worksheets(2).Hyperlinks.Add Anchor:=Selection, Address:= _
' ' "http://www.skylife.it/static/epg/timeline/data/" + percorso + "/" + id + ".xml", _
' ' TextToDisplay:= _
' ' "http://www.skylife.it/static/epg/timeline/data/" + percorso + "/" + id + ".xml"
' End With
Worksheets(2).Cells(riga, 1) = id
Worksheets(2).Cells(riga, 2) = percorso
Worksheets(2).Cells(riga, 3) = minititolo
Worksheets(2).Cells(riga, 4) = ChanName(CurChan)
Worksheets(2).Cells(riga, 5) = "http://www.skylife.it/static/epg/timeline/data/" + percorso + "/" + id + ".xml"
If Len(minititolo) < 6 Then
Call Scarica(percorso, id, riga)
Worksheets(2).Cells(riga, 3) = Worksheets(1).Cells(riga, 5)
Worksheets(2).Cells(riga, 6) = "*"
End If
End If
frmSetup.txtStatus.Caption = "Elaborazione ' " & gen & "'... Estrazione dati evento... Fatto.": DoEvents
If abort = True Then Exit For
Next
End If
GoTo oklabel::
errlabel::
MsgBox ("Errore " & Err.Description & " in 'Elabora(" & gen & "," & Str(riga) & "')")
Stop
oklabel::
Elabora = riga ' Restituisce l'ultima riga scritta, per poter partire dalla successiva alla prossima chiamata.
End Function
Sub Cancella()
If MsgBox("Sicuro di voler cancellare tutto?", vbYesNo, "Conferma cancellazione") = vbNo Then Exit Sub
Cells.Select
Selection.ClearContents
Call InizializzaFoglio
End Sub
Sub InizializzaFoglio()
Cells(2, 1) = "Canale"
Cells(2, 2) = "Posizione"
Cells(2, 3) = "Giorno"
Cells(2, 4) = "Data"
Cells(2, 5) = "Orario"
Cells(2, 6) = "Durata (min.)"
Cells(2, 7) = "Titolo"
Cells(2, 8) = "Trama"
Range("A2:F2").Select
With Selection.Interior
.ColorIndex = 48
.pattern = xlSolid
End With
Selection.Font.bold = True
Range("E2").Select
Selection.AutoFilter
End Sub
Sub Fermatutto()
If MsgBox("Interrompere scaricamento? (sara' necessario ricominciare da capo)", vbYesNo, "Richiesta conferma interruzione") = vbNo Then Exit Sub
abort = True
End Sub
Sub Pausa()
MsgBox ("Premere CTRL+PAUSA e cliccare su DEBUG per interrompere. " & vbCrLf & "Dopo, premere F5 NELL'EDITOR per continuare, o il tasto quadrato in alto (=stop) nell'editor per terminare.")
End Sub
Sub Auto_open()
Call InizializzaFoglio
frmSetup.Show
End Sub
Sub CicloScarica_Old()
' Scandisce tutte le checkbox per stabilire di quale giorno e di quale
' genere scaricare i palinsesti.
Dim genere As String
Dim d As Integer
NumEventi = 1
' Definisce le espressioni regolari necessarie ad eliminare le informazioni inutili
If Dir("C:\temp", vbDirectory) = "" Then MkDir ("c:\temp")
If frmSetup.chkGen1.Value = True Then genere = frmSetup.chkGen1.Caption
If frmSetup.chkDay1.Value = 1 Then giorno = 1
NuovoInizio = 2
For gen = 1 To 8
For c = 0 To frmSetup.Controls.Count - 1 ' Esamina tutti i controlli della form
If frmSetup.Controls.Item(c).Name = "chkGen" & LTrim$(Str$(gen)) Then
If frmSetup.Controls.Item(c).Value = True Then ' Per ogni genere richiesto,...
genere = frmSetup.Controls.Item(c).Caption
For d = 1 To 7 ' Esamina tutti i checkbox dei giorni cercando quelli selezionati.
For c2 = 0 To frmSetup.Controls.Count - 1
'Debug.Print frmSetup.Controls.Item(c2).Name
If frmSetup.Controls.Item(c2).Name = "chkDay" & LTrim$(Str$(d)) Then
If frmSetup.Controls.Item(c2).Value = True Then ' Scarica programmazione dei soli giorni selezionati.
'Debug.Print "Scarico " & frmSetup.Controls.Item(c).Caption & " per giorno " & Str(d)
NuovoInizio = Modulo1.Elabora(genere, d, NuovoInizio)
If abort = True Then Exit Sub
End If
Exit For
End If
Next
Next
End If
Exit For
End If
Next
Next
riga = 2
While Cells(riga, 5) <> ""
riga = riga + 1
With Worksheets(2)
.Hyperlinks.Add .Range("E" & LTrim$(riga)), Cells(riga, 5)
End With
Wend
frmSetup.txtStatus.Caption = "TERMINATO."
Call InizializzaFoglio
End Sub
Sub test()
For riga = 1 To 100
With Worksheets(2)
.Hyperlinks.Add .Range("E" & LTrim$(riga)), Cells(riga, 5)
End With
Next
End Sub
Sub CicloScarica()
If frmSetup.txtSearch.Text <> "" Then ricerca = frmSetup.txtSearch.Text ' DEBUG
NumEventi = 1
NumeroEventiSelezionati = 2
'If frmSetup.chkGen1.Value = True Then genere = frmSetup.chkGen1.Caption
If frmSetup.chkDay1.Value = 1 Then giorno = 1
NuovoInizio = 2
GenNum = 0 ' Numero d'ordine del genere da scaricre.
DayNum = 0 ' Numero d'ordine del giorno da scaricare.
For gen = 1 To 8
For c = 0 To frmSetup.Controls.Count - 1 ' Esamina tutti i controlli della form
If frmSetup.Controls.Item(c).Name = "chkGen" & LTrim$(Str$(gen)) Then
GenNum = GenNum + 1
If frmSetup.Controls.Item(c).Value = True Then ' Per ogni genere richiesto,...
'genere = frmSetup.Controls.Item(c).Caption
For d = 1 To 7 ' Esamina tutti i checkbox dei giorni cercando quelli selezionati.
For c2 = 0 To frmSetup.Controls.Count - 1
'Debug.Print frmSetup.Controls.Item(c2).Name
If frmSetup.Controls.Item(c2).Name = "chkDay" & LTrim$(Str$(d)) Then
DayNum = DayNum + 1
If frmSetup.Controls.Item(c2).Value = True Then ' Scarica programmazione dei soli giorni selezionati.
'Debug.Print "Scarico " & frmSetup.Controls.Item(c).Caption & " per giorno " & Str(d)
Call ScaricaNew((GenNum), (d))
If abort = True Then Exit Sub
End If
Exit For
End If
Next
Next
End If
Exit For
End If
Next
Next
riga = 2
While Cells(riga, 5) <> ""
riga = riga + 1
With Worksheets(2)
.Hyperlinks.Add .Range("E" & LTrim$(riga)), Cells(riga, 5)
End With
Wend
frmSetup.txtStatus.Caption = "TERMINATO."
Call InizializzaFoglio
End Sub
Sub ScaricaNew(G As Integer, NumGiorno)
' GENERE: http://guidatv.sky.it/app/guidatv/contenuti/data/grid/grid_sport_channels.js
' CANALE: http://guidatv.sky.it/app/guidatv/contenuti/data/grid/09_02_19/ch_371.js
' EVENTO: http://guidatv.sky.it/EpgBackend/event_description.do?eid=17489032
Dim ElencoEventi As String
Path = "C:\temp\"
Call InitVars
' ********* Scarica il file del genere
'For G = 1 To NumeroGeneri
nomefile = Path & "Canali_" & genere(G) & ".txt"
StrUrl = Replace(STRINGA_GENERE, "GGGGGGGG", genere(G))
Debug.Print "Scarico " & StrUrl & "..."
errcode = URLDownloadToFile(0, StrUrl, nomefile, 0, 0)
If errcode = 0 Then
'Debug.Print "OK"
Else
Debug.Print genere(G), ": ERRORE ", errcode
errcode = 0
End If
'Next
giorno = Lead0(Val(Day(Date - 1 + NumGiorno)))
Mese = Lead0(Val(Month(Date - 1 + NumGiorno)))
Anno = Mid$(Year(Date - 1 + NumGiorno), 3, 2)
StringaData = Anno & "_" & Mese & "_" & giorno
'G = 1 ' DEBUG
Debug.Print "Elaboro " & genere(G) & " per giorno " & StringaData
Open "Canali_" & genere(G) & ".txt" For Input As #1
ElencoCanali = Input$(LOF(1), 1)
Close #1
FineCanale = 1
While InStr(FineCanale, ElencoCanali, "{id:") > 0
InizioCanale = InStr(FineCanale, ElencoCanali, "{id:") + 5
FineCanale = InStr(InizioCanale, ElencoCanali, Chr$(34))
LunghCanale = FineCanale - InizioCanale
canale = Mid$(ElencoCanali, InizioCanale, LunghCanale)
InizioPosizione = InStr(FineCanale, ElencoCanali, "number:") + 8
FinePosizione = InStr(InizioPosizione, ElencoCanali, Chr$(34))
LunghPosizione = FinePosizione - InizioPosizione
posizione = Mid$(ElencoCanali, InizioPosizione, LunghPosizione)
InizioNome = InStr(FineCanale, ElencoCanali, "name:") + 6
FineNome = InStr(InizioNome, ElencoCanali, Chr$(34))
LunghNome = FineNome - InizioNome
nome = Mid$(ElencoCanali, InizioNome, LunghNome)
If frmSetup.chkSkipChan.Value = True Then
If frmSetup.txtChan.Text = posizione Then
' ******************** Scarica file-eventi:
nomefile = Path & "Eventi_" & Str$(canale) & "_" & Replace(nome, " ", "_") & "_(" & posizione & ").txt"
StrUrl = Replace(STRINGA_CANALE, "CCCCCCCC", canale)
StrUrl = Replace(StrUrl, "AA_MM_GG", StringaData)
'Debug.Print "Scarico " & StrUrl & "..."
errcode = URLDownloadToFile(0, StrUrl, nomefile, 0, 0)
If errcode = 0 Then
'Debug.Print "OK"
Debug.Print " Elaboro canale " & Replace(nome, " ", "_")
Open nomefile For Input As #1
ElencoEventi = Input$(LOF(1), 1)
Close #1
Call JSON_Extractor((ElencoEventi), (canale), (posizione), (nome), genere(G), (StringaData))
Else
Debug.Print canale, ": ERRORE ", errcode
errcode = 0
End If
Else
Debug.Print "Salto canale " & posizione & " (" & nome & ")"
End If
End If
Wend
End Sub
Function Lead0(n As Integer) As String
If n < 10 Then Lead0 = "0" & LTrim(Str(n)) Else Lead0 = LTrim(Str(n))
End Function
Sub JSON_Extractor(TableString As String, canale As String, posizione As String, nome As String, genere As String, Data As String)
Prima = InStr(TableString, "[") + 1
Ultima = InStrRev(TableString, "]") - 1
TableString = Mid$(TableString, Prima, Ultima - Prima)
While InStr(TableString, "{") > 0
NumEventi = NumEventi + 1
InizioRiga = InStr(TableString, "{") + 1
FineRiga = InStr(TableString, "}") - 1
LunghRiga = FineRiga - InizioRiga + 1
riga = Replace(Mid$(TableString, InizioRiga, LunghRiga), Chr$(13) & Chr$(10), "")
riga = Replace(riga, "\'", "`") ' L'apostrofo è un delimitatore, se è presente nel testo, confonde il programma...
'Debug.Print riga
Colonna = COLONNA_BASE ' Le prime colonne sono occupate da altri campi.
Selezionato = False ' Se nella riga c'e' un evento selezionato, lo scrive anche nel foglio a parte.
' ****** Estrae campi dalla riga:
While InStr(riga, "'") > 0
Colonna = Colonna + 1
InizioCampo = InStr(riga, "'")
FineCampo = InStr(InizioCampo + 1, riga, "'")
LunghCampo = FineCampo - InizioCampo - 1
If LunghCampo > 0 Then
campo = Replace(Mid$(riga, InizioCampo + 1, LunghCampo), Chr$(13) & Chr$(10), "")
Else
campo = "VUOTO"
End If
If Colonna = COLONNA_BASE + COLONNA_ID Then IdEvento = campo
If Colonna = COLONNA_BASE + COLONNA_ORARIO Then OrarioEvento = campo
If Colonna = COLONNA_BASE + COLONNA_DURATA Then DurataEvento = campo
If Colonna = COLONNA_BASE + COLONNA_TITOLO Then TitoloEvento = campo
If Colonna = COLONNA_BASE + COLONNA_TRAMA Then TramaEvento = campo
DataEvento = Mid$(Data, 7, 4) & "/" & Mid$(Data, 4, 2) & "/" & "20" & Mid$(Data, 1, 2)
If Weekday(DataEvento) = 1 Then
GiornoSettimanaEvento = WeekdayName(7)
Else
GiornoSettimanaEvento = WeekdayName(Weekday(DataEvento) - 1)
End If
Worksheets(2).Cells(NumEventi, 1) = genere
Worksheets(2).Cells(NumEventi, 2) = canale
Worksheets(2).Cells(NumEventi, 3) = posizione
Worksheets(2).Cells(NumEventi, 4) = nome
Worksheets(2).Cells(NumEventi, Colonna) = campo
If InStr(UCase$(campo), UCase$(ricerca)) > 0 Then ' Se l'evento corrisponde al campo di ricerca...
Selezionato = True
NumeroEventiSelezionati = NumeroEventiSelezionati + 1
End If
If Selezionato = True Then
Debug.Print "Scarico dettagli evento " & IdEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 1) = nome
Worksheets(1).Cells(NumeroEventiSelezionati, 2) = posizione
Worksheets(1).Cells(NumeroEventiSelezionati, 3) = GiornoSettimanaEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 4) = DataEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 5) = OrarioEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 6) = DurataEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 7) = TitoloEvento
Worksheets(1).Cells(NumeroEventiSelezionati, 8) = TramaEvento
End If
'Debug.Print " "; campo,
riga = Right$(riga, Len(riga) - FineCampo - 1)
Wend
TableString = Right$(TableString, Len(TableString) - FineRiga - 1)
'Debug.Print
Wend
'Debug.Print
End Sub
)
