Outlook ical exporter

Soyez le premier à donner votre avis sur cette source.

Vue 7 966 fois - Téléchargée 370 fois

Description

L'API .NET d'Outlook fournit une méthode standard "ForwardAsVCal" qui transmet un mail avec en pièce jointe un fichier ics qui par contre ne contient pas l'élément CATEGORIES de la spécication ical v2.0 des VEVENT

Cette Source fait un upload du calendrier et des tâches outlook de l'odrinateur local vers le serveur FTP de votre choix. Il y a un fichier *.ics par categorie Outlook ou * est le nom de la categorie.

<i>The .NET Outlook API does provide a standard method ForwardAsVcal which does send a mail with attached ics file that perhaps does not contains CATEGORIES component in VEVENT ITEMS

This source does an upload of the main local computer outlook calendar as well as todo tasks. There is one *.ics upload per Outlook Category where * is the category name.
</i>

Source / Exemple :


 Imports Microsoft.Office.Interop.Outlook Imports System.IO Imports System.Text Imports System.Array Imports CalExporter.FTPclient Module CalItem     Sub Main()         Dim objOL As Object         Dim s As New OutlookAddIn.GetApplication         objOL = s.GetApplicationObject()         Dim MyNameSpace As Microsoft.Office.Interop.Outlook.NameSpace         MyNameSpace = objOL.GetNameSpace("MAPI")         Dim cats As Microsoft.Office.Interop.Outlook.Categories         cats = MyNameSpace.Categories         If (cats.Count > 1) Then             For Each cat As Microsoft.Office.Interop.Outlook.Category In cats                 CatOutPut(MyNameSpace, cat)             Next         End If     End Sub     Sub CatOutPut(ByRef MyNameSpace As Microsoft.Office.Interop.Outlook.NameSpace, ByVal category As Microsoft.Office.Interop.Outlook.Category)         Dim out As String         out = "BEGIN:VCALENDAR" & Chr(10)         out += "PRODID:-//hacksw/handcal//NONSGML v1.0//EN" & Chr(10)         out += "VERSION:2.0" & Chr(10)         Dim myFolder As Object         myFolder = MyNameSpace.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderCalendar)         Dim myTaskFolder As Object         myTaskFolder = MyNameSpace.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderTasks)         Dim myTaskItems As Object         myTaskItems = myTaskFolder.Items         Dim myItems As Object         myItems = myFolder.Items         Dim e As Microsoft.Office.Interop.Outlook.AppointmentItem         For Each e In myItems             If e.Categories <> String.Empty Then                 If e.Categories.Contains(category.Name) Then                     out += "BEGIN:VEVENT" & Chr(10)                     out += "UID:" & e.EntryID & Chr(10)                     If e.Categories <> "" Then                         out += "CATEGORIES:" & NoSpac(e.Categories.Replace(";"c, ","c)) & Chr(10)                     End If                     out += "DTSTAMP:" & ToDate69(e.CreationTime.ToUniversalTime) & Chr(10)                     out += "DTSTART:" & ToDate69(e.Start.ToUniversalTime) & Chr(10)                     out += "DTEND:" & ToDate69(e.End.ToUniversalTime) & Chr(10)                     out += "SUMMARY:" & RFC5545_TEXT(e.Subject) & Chr(10)                     'out += "DESCRIPTION:" & RFC5545_TEXT(e.Body) & Chr(10)                     out += "LOCATION:" & RFC5545_TEXT(e.Location) & Chr(10)                     If e.RecurrenceState = OlRecurrenceState.olApptMaster Then                         out += ("RECURRENCE-ID:") & ToDate69(e.StartUTC) & Chr(10)                         out += "RRULE:"                         Dim f As Microsoft.Office.Interop.Outlook.RecurrencePattern                         f = e.GetRecurrencePattern()                         'Console.WriteLine("VALUES:monthofyear" & f.MonthOfYear & "dayofmonth:" & f.DayOfMonth & "daysofweekmask:" & f.DayOfWeekMask & "interval:" & f.Interval & "instance:" & f.Instance & "type:" & f.RecurrenceType)                         Select Case f.RecurrenceType                             Case OlRecurrenceType.olRecursYearNth                                 out += "FREQ=YEARLY;"                                 out += "INTERVAL=" & f.Interval & ";"                                 out += "BYMONTH=" & f.MonthOfYear & ";"                                 out += "BYDAY=" & GetDays(f.DayOfWeekMask) & ";"                                 out += "BYMONTHDAY=" & GetMonthDays(f.Instance) & ";"                             Case OlRecurrenceType.olRecursMonthNth                                 out += "FREQ=MONTHLY;"                                 out += "INTERVAL=" & f.Interval & ";"                                 out += "BYDAY=" & GetDays(f.DayOfWeekMask) & ";"                                 out += "BYMONTHDAY=" & GetMonthDays(f.Instance) & ";"                             Case OlRecurrenceType.olRecursYearly                                 out += "FREQ=YEARLY;"                                 out += "INTERVAL=" & f.Interval & ";"                                 out += "BYMONTH=" & f.MonthOfYear & ";"                                 out += "BYMONTHDAY=" & f.DayOfMonth & ";"                             Case OlRecurrenceType.olRecursMonthly                                 out += "FREQ=MONTHLY;"                                 out += "INTERVAL=" & f.Interval & ";"                                 out += "BYMONTHDAY=" & f.DayOfMonth & ";"                             Case OlRecurrenceType.olRecursWeekly                                 out += "FREQ=WEEKLY;"                                 out += "INTERVAL=" & f.Interval & ";"                                 out += "BYDAY=" & GetDays(f.DayOfWeekMask) & ";"                             Case OlRecurrenceType.olRecursDaily                                 out += "FREQ=DAILY;"                                 out += "INTERVAL=" & f.Interval & ";"                         End Select                         If f.NoEndDate Then                             out += "UNTIL=45001231235900Z"                         Else                             Dim endDate As Date                             endDate = f.PatternEndDate.ToUniversalTime                             out += "UNTIL=" & ToDate69(endDate.ToUniversalTime)                         End If                         out += Chr(10)                         If f.Exceptions.Count > 1 Then                             out += "EXDATE:"                             Dim isLast = False                             Dim enumerator As IEnumerator                             enumerator = f.Exceptions.GetEnumerator()                             enumerator.MoveNext()                             While Not isLast                                 out += ToDate69(enumerator.Current.OriginalDate.ToUniversalTime)                                 If Not enumerator.MoveNext Then                                     isLast = True                                 Else                                     out += ","                                 End If                             End While                             out += Chr(10)                         End If                     ElseIf e.RecurrenceState = OlRecurrenceState.olApptOccurrence Then                         'treat exception cases                         out += ("RECURRENCE-ID:") & ToDate69(e.StartUTC) & Chr(10)                         'Console.WriteLine("OCCURRENCE")                     End If                     out += "END:VEVENT" & Chr(10)                 End If             End If         Next         Dim task As Microsoft.Office.Interop.Outlook.TaskItem         For Each task In myTaskItems             If task.Categories <> String.Empty Then                 If task.Categories.Contains(category.Name) Then                     out += "BEGIN:VTODO" & Chr(10)                     out += "UID:" & task.EntryID & Chr(10)                     out += "DTSTAMP:" & ToDate69(task.CreationTime) & Chr(10)                     If task.Status = OlTaskStatus.olTaskComplete Then                         out += "COMPLETED:" & ToDate69(task.DateCompleted.ToUniversalTime) & Chr(10)                     End If                     If Date.Compare(task.StartDate, New Date(4499, 12, 31)) < 0 Then                         out += "DTSTART:" & ToDate69(task.StartDate.ToUniversalTime)                     End If                     If task.Status = OlTaskStatus.olTaskInProgress Then                         out += "STATUS:IN-PROGRESS" & Chr(10)                     ElseIf task.Status = OlTaskStatus.olTaskWaiting Then                         out += "STATUS:NEEDS-ACTION" & Chr(10)                     End If                     out += "SUMMARY:" & task.Subject & Chr(10)                     If Date.Compare(task.DueDate, New Date(4499, 12, 31)) < 0 Then                         out += "DUE:" & ToDate69(task.DueDate.ToUniversalTime) & Chr(10)                     End If                     out += "CATEGORIES:" & NoSpac(task.Categories.Replace(";"c, ","c)) & Chr(10)                     out += "END:VTODO" & Chr(10)                 End If                 End If         Next         out += "END:VCALENDAR" & Chr(10)         File.WriteAllText("C:\Program1\" & category.Name & ".ics", out, System.Text.Encoding.UTF8)         Dim ftp As FTPclient         Dim localFile As String = "C:\Program1\" & category.Name & ".ics"         Dim remoteFile As String = "www/cal/calendars/" & category.Name & ".ics"         Const host As String = "[ftp://FTPSITE.COM/]"         Const username As String = "USERNAME"         Const password As String = "<PASSWORD>"         ftp = New FTPclient(host, username, password)         ftp.Upload(localFile, remoteFile)     End Sub     Public Function ToDig(ByVal value As Integer) As String         If value <= 9 Then             Dim a As String             a = "0" & value             ToDig = a         Else             ToDig = value.ToString         End If         Exit Function     End Function     Public Function NoSpac(ByVal value As String) As String         Dim str As String         str = ""         For Each ch As Char In value.ToCharArray             If ch <> " "c Then                 str += ch             End If         Next         NoSpac = str         Exit Function     End Function     Public Function ToDate69(ByVal d As Date) As String         Dim str As String         str = d.Year & ToDig(d.Month) & ToDig(d.Day) & ToDig(d.Hour) & ToDig(d.Minute) & "00Z"         ToDate69 = str         Exit Function     End Function     Public Function GetDays(ByVal d As Integer) As String         Dim out As String         out = ""         Dim once As Boolean         once = False         If (d And OlDaysOfWeek.olSunday) Then             out += "SU"             once = True         End If         If (d And OlDaysOfWeek.olMonday) Then             If (once) Then                 out += ","             End If             out += "MO"             once = True         End If         If (d And OlDaysOfWeek.olTuesday) Then             If (once) Then                 out += ","             End If             out += "TU"             once = True         End If         If (d And OlDaysOfWeek.olWednesday) Then             If (once) Then                 out += ","             End If             out += "WE"             once = True         End If         If (d And OlDaysOfWeek.olThursday) Then             If (once) Then                 out += ","             End If             out += "TH"             once = True         End If         If (d And OlDaysOfWeek.olFriday) Then             If (once) Then                 out += ","             End If             out += "FR"             once = True         End If         If (d And OlDaysOfWeek.olSaturday) Then             If (once) Then                 out += ","             End If             out += "SA"         End If         GetDays = out         Exit Function     End Function     Public Function GetMonthDays(ByVal xieme As Integer) As String         Select Case xieme             Case 1                 GetMonthDays = "1,2,3,4,5,6,7"             Case 2                 GetMonthDays = "8,9,10,11,12,13,14"             Case 3                 GetMonthDays = "15,16,17,18,19,20,21"             Case 4                 GetMonthDays = "22,23,24,25,26,27,28"             Case 5                 GetMonthDays = "29,30,31"             Case Else                 GetMonthDays = "0"         End Select         Exit Function     End Function     Public Function RFC5545_TEXT(ByVal s As String) As String         If s <> String.Empty Then             s = s.Replace("\", "\\")             s = s.Replace(";", "\;")             s = s.Replace(",", "\,")             s = s.Replace(vbNewLine, "\n")         End If         RFC5545_TEXT = s         Exit Function     End Function End Module 

Conclusion :


La méthode pour obtenir un "Handle" sur Outlook peut varier selon que vous utilisiez exchange ou non, je conseille cet excellent site : outlookcode.com

Aussi ai-je publié une page de démonstration avec ce programme : http://www.xsimo.com/cal.htm

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

scake
Messages postés
2
Date d'inscription
samedi 30 décembre 2000
Statut
Membre
Dernière intervention
2 juillet 2010
-
Je souhaite pouvoir publier un ics sur mon ftp avec icalendar comme vous le faites.
Je ne parviens pas à faire tourner cette macro sous outlook 2010.
J'ai renseigné le site ftp et le nom et pass dans le fichier CalItem, mais je présume que c'est plus compliqué que cela...
cs_xsimo
Messages postés
7
Date d'inscription
mercredi 22 novembre 2006
Statut
Membre
Dernière intervention
7 mars 2010
-
J'utilise cette macro avec Outlook 2007, j'imagine qu'il y a effectivement un moyen de l'adapter pour la version 2010, vous pourriez consulter le site outlookcode.com pour connaitre le moyen d'obtenir un "handle" sur Outlook 2010 car à mon avis c'est cette partie qui diffère dans le fichier GetApplication.vb
cs_xsimo
Messages postés
7
Date d'inscription
mercredi 22 novembre 2006
Statut
Membre
Dernière intervention
7 mars 2010
-
Un gros merci à Howard Richards ( http://twitter.com/conficient ) pour sa contribution FTPClient : http://www.codeproject.com/Articles/11991/An-FTP-client-library-for-NET-2-0

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.