Un esempio di come si possa estrarre il calendario degli appuntamenti da Outlook per i giorni successivi e riportarlo su di un foglio di calcolo.
 Qui a destra un esempio del risultato dell'esecuzione della macro:
- viene impostato il primo giorno del calendario con la data del giorno;
- vengono cercati tutti gli eventi compresi fra la prime l'ultima data del calendario;
- il calendario รจ diviso in frazioni di ora come riportato nella riga 5 nascosta (devono essere inserite ore non numeri)
- il singolo evento viene riportato sul calendario con una cella unita formattata con l'eventuale colore della categoria di outlook;
- eventuali note dell'evento sono riportati come commenti.
|
La definizione del tipo dati "categoria":
Recupera nomi e colore delle categorie impostate in Outlook:
Dim oCategory
As Category
If (Outlook.Session.Categories.Count > 0)
Then
Dim Categorie()
As tCategoria
ReDim Categorie(1
To Outlook.Session.Categories.Count)
i = 1
For Each oCategory
In Outlook.Session.Categories
Categorie(i).Nome = oCategory.Name
Categorie(i).Colore = oCategory.CategoryGradientBottomColor
i = i + 1
Next
End If
Apre il calendario e imposta il filtro per le date di inizio e fine del periodo da analizzare
Set oCalendario = Outlook.Session.GetDefaultFolder(olFolderCalendar)
Set oEventi = oCalendario.Items
oEventi.IncludeRecurrences = True
oEventi.Sort "[Start]"
' filtro data
sFiltroData = "[Start] >=
'" & Format$(dtInizio, "dd/mm/yyyy hh:mm AMPM") & _
"
' AND [End] <= '" & Format$(dtFine, "dd/mm/yyyy hh:mm AMPM") & "'"
Set oEventiFiltrati = oEventi.Restrict(sFiltroData)
Riporta gli eventi sulla tabella del calendario
Dim oEvento
As Outlook.AppointmentItem
For Each oEvento
In oEventiFiltrati
dtInizio = oEvento.Start
dtFine = oEvento.End
Categoria = oEvento.Categories
Oggetto = oEvento.Subject
TestoNote = oEvento.Body
'colore da categoria
i =
LBound(Categorie)
While (Categoria <> Categorie(i).Nome And i <
UBound(Categorie))
i = i + 1
Wend
Colore = RGB(255, 255, 255)
If (Categoria = Categorie(i).Nome)
Then
Colore = Categorie(i).Colore
End If
' trova la riga del giorno di inizio
Rci = 1
While (TabGiorni.
Cells(Rci, 1) <>
Int(dtInizio))
Rci = Rci + 1
Wend
' trova la riga di fine
Rcf = Rci
While (TabGiorni.
Cells(Rcf, 1) <>
Int(dtFine))
Rcf = Rcf + 1
Wend
' colonna dell'ora di inizio
Ci = 1
While (TabOre.
Cells(1, Ci) < TimeValue(dtInizio))
Ci = Ci + 1
Wend
' colonna dell'ora di fine
OraFine = TimeValue(dtFine)
If (OraFine = 0)
Then
OraFine = 25
Rcf = Rcf - 1
End If
Cf = Ci + 1
While (TabOre.
Cells(1, Cf + 1) < OraFine And Cf < TabCalendario.
Columns.Count)
Cf = Cf + 1
Wend
' disegna le celle sul calendario
If (Rci = Rcf)
Then
Set Celle =
Range(TabCalendario.
Cells(Rci, Ci), TabCalendario.
Cells(Rcf, Cf))
FormattaEvento Celle:=Celle, Oggetto:=Oggetto, Colore:=Colore, Note:=Note
Else
Set Celle =
Range(TabCalendario.
Cells(Rci, Ci), TabCalendario.
Cells(Rci, TabCalendario.
Columns.Count))
FormattaEvento Celle:=Celle, Oggetto:=Oggetto, Colore:=Colore, Note:=Note
For Rc = Rci + 1
To Rcf - 1
Set Celle =
Range(TabCalendario.
Cells(Rc, 1), TabCalendario.
Cells(Rc, TabCalendario.
Columns.Count))
FormattaEvento Celle:=Celle, Oggetto:="", Colore:=Colore, Note:=""
Next Rc
Set Celle =
Range(TabCalendario.
Cells(Rcf, 1), TabCalendario.
Cells(Rcf, Cf))
FormattaEvento Celle:=Celle, Oggetto:="", Colore:=Colore, Note:=""
End If
Next oEvento
La formattazione del singolo evento:
Private Sub FormattaEvento(
Celle,
Oggetto,
Colore,
Note)
Celle.MergeCells = True
Celle.Interior.Color =
Colore
Celle.Value =
Oggetto
End Sub
Gli esempi contenuti nel sito sono per uso personale, non é consentito l'uso professionale, commerciale o la riproduzione senza autorizzazione.
