Création/cancel meeting sur calendrier d'un autre que celui du compte principal

Commenter

Contenu du snippet

Le but est d'envoyer des demandes de réunions depuis le calendrier d'un compte qui n'est pas le calendrier principal.

Pour l'utilisation j'ai réaliser des éléments compteinformatique et appointment. L'élément compteinformatique contient les informations liée au compte avec lequel on désire envoyer le meeting. L'élément appointment contient toutes les informations d'une demande de réunion. Du coup, j'ai ajuster mon code à ces éléments, mais le principe est identique :
création d'un namespace, création d'un objet récipient, création d'un objet dans le namespace de l'objet récipient. Utiliser GetSharedDefaultFolder

Cela dis, j'ai un problème pour la réalisation de mises à jour. La mise à jour implique la conservation de l'identifiant du rendez-vous : ce n'est donc pas une annulation suivie d'une création de meeting!!!
Il n'y a pas de soucis pour modifier le sujet, mais la modification de dates entraine automatiquement une erreur (je ne précise pas laquelle, car j'en ai rencontrer plusieurs en modifiant la construction de la recherche du meeting)

SI VOUS AVEZ DES INFOS AU SUJET DES MISES à JOURS, JE SUIS PRENEUR!

PS : ce code a été réaliser sur la base de différents codes
'http://social.msdn.microsoft.com/forums/fr-FR/vbgeneral/thread/57df678c-a617-4e62-8a8e-9b219b2b93fb/
'http://support.microsoft.com/kb/313789/

Source / Exemple : 


Mon premier code de test :

Public Sub CreateOtherUserMeeting()

        Dim objolApp As Outlook.Application = New Outlook.Application
        Dim objNS As Outlook.NameSpace
        Dim objRecip As Outlook.Recipient
        Dim objFolder As Outlook.MAPIFolder
        Dim objAppt As Outlook.AppointmentItem
        'Dim objAppt As Outlook.MeetingItem
        Dim strName As String

        ' ### name or email address of person whose Calendar you want to use ###
        strName = "mailorganizer@forchooseCalendar.com"

        'Get MAPI NameSpace
        objNS = objolApp.GetNamespace("MAPI")

        Try
            objRecip = objNS.CreateRecipient(strName)
            objRecip.Resolve()

            'Vérification de l'existance du calendrier de l'organisateur désiré
            If objRecip.Resolved Then
                objFolder = objNS.GetSharedDefaultFolder(objRecip, Outlook.OlDefaultFolders.olFolderCalendar)
                objAppt = objFolder.Items.Add(Outlook.OlItemType.olAppointmentItem)

                With objAppt
                    .Start = DateAdd("d", 1, System.DateTime.Now)
                    .Duration = 30

                    .Subject = "Test   " & FormatDateTime(System.DateTime.Now, DateFormat.ShortTime)
                    .Body = "hello world"
                    .Location = "sam world"
                    .ReminderSet = True
                    .ReminderMinutesBeforeStart = 5
                    .BusyStatus = Outlook.OlBusyStatus.olBusy
                    .AllDayEvent = False
                    .MeetingStatus = Outlook.OlMeetingStatus.olMeeting
                    '.Save()
                End With

                'recurring meeting
                Dim myPattern As Outlook.RecurrencePattern = objAppt.GetRecurrencePattern
                myPattern.RecurrenceType = Outlook.OlRecurrenceType.olRecursDaily
                myPattern.Interval = 1
                myPattern.PatternStartDate = #12/19/2008#
                myPattern.PatternEndDate = #1/15/2009#

                'Add required attendees
                Dim objRecipts As Outlook.Recipients = objAppt.Recipients

                objRecip = objRecipts.Add("mailrequest@attendee.com")
                objRecip.Type = Outlook.OlMeetingRecipientType.olRequired

                '' Add optional attendee.
                'objRecip = objRecipts.Add("UserTest2") ' TODO:
                'objRecip.Type = Outlook.OlMeetingRecipientType.olOptional

                objRecipts.ResolveAll()

                objAppt.Save() 'must be save befor send to send also the recurring meetings

                objAppt.Send()
            End If

        Catch ex As System.Runtime.InteropServices.COMException
            Select Case ex.ErrorCode
                Case -2147467260    ' User responded NO to security prompt
                    MessageBox.Show("It won't work unless you say Yes to the security prompt.")
                Case -1767636707    ' store not available to GetSharedDefaultFolder
                    MessageBox.Show("Information store for " & objRecip.Name & " not available.")
                Case -1664876273    ' no permissions for folder
                    MessageBox.Show("You do not have permission to view the folder.")
                Case -632274939     ' read-only permission, cannot write
                    MessageBox.Show("You do not have permission to create a new item in the folder.")
                Case -2147221219
                    MessageBox.Show("The calendar of """ & strName & """ don't exist.")
                Case Else
                    MessageBox.Show("COMException - " & ex.ErrorCode)
            End Select

        Catch ex As Exception
            MessageBox.Show(ex.Message, ex.ToString)

        Finally
            objFolder = Nothing
            objAppt = Nothing
            objRecip = Nothing
            objNS = Nothing
            objolApp = Nothing

        End Try

    End Sub

Deviens après quelques modifications :

    'Delete the meeting on the calendar and send the cancellation to the attendees
    Public Function SendMeetingCancel_CalendarSelected(ByVal compte As CompteInformatique, _
                                                       ByVal myAppt As Appointment)
        Dim objolApp As Outlook.Application = New Outlook.Application
        Dim objNS As Outlook.NameSpace
        Dim objRecip As Outlook.Recipient
        Dim objFolder As Outlook.MAPIFolder
        'Dim objAppt As Outlook.AppointmentItem
        Dim strName As String = compte.Mail

        objNS = objolApp.GetNamespace("MAPI")

        Try
            objRecip = objNS.CreateRecipient(strName)
            objRecip.Resolve()

            If (objRecip.Resolve) * (myAppt.UIDoutlook <> "") Then

                objFolder = objNS.GetSharedDefaultFolder(objRecip, Outlook.OlDefaultFolders.olFolderCalendar)
                'objAppt = objFolder.Items.Add(Outlook.OlItemType.olAppointmentItem)

                'MsgBox(objFolder.Items.Count) 'compter le nombre d'éléments dans le dossier
                For Each objapptCal As Outlook.AppointmentItem In objFolder.Items
                    If objapptCal.EntryID = myAppt.UIDoutlook Then
                        objapptCal.MeetingStatus = Outlook.OlMeetingStatus.olMeetingCanceled
                        'objapptCal.Save()
                        objapptCal.Send()
                        objapptCal.Delete()
                    End If
                    'MsgBox(objapptCal.Subject)
                    'MsgBox(objapptCal.GlobalAppointmentID)
                    'MsgBox(objapptCal.EntryID)
                Next
                'objAppt.Save() 'must be save befor send to send also the recurring meetings
                'objAppt.Send()
                Return True

            ElseIf (myAppt.UIDoutlook = "") Then
                MsgBox("aucun identifiant outlook n'a été définit pour ce cours : " & myAppt.UID)
                Return False
            End If
            'MsgBox(objRecip.Resolve)

        Catch ex As System.Runtime.InteropServices.COMException
            Select Case ex.ErrorCode
                Case -2147467260    ' User responded NO to security prompt
                    MessageBox.Show("It won't work unless you say Yes to the security prompt.")
                Case -1767636707    ' store not available to GetSharedDefaultFolder
                    MessageBox.Show("Information store for " & objRecip.Name & " not available.")
                Case -1664876273    ' no permissions for folder
                    MessageBox.Show("You do not have permission to view the folder.")
                Case -632274939     ' read-only permission, cannot write
                    MessageBox.Show("You do not have permission to create a new item in the folder.")
                Case -2147221219
                    MessageBox.Show("The calendar of """ & strName & """ don't exist.")
                Case Else
                    MessageBox.Show("COMException - " & ex.ErrorCode)
            End Select
            Return False

        Catch ex As Exception
            MessageBox.Show(ex.Message, ex.ToString)
            Return False

        Finally
            objFolder = Nothing
            'objAppt = Nothing
            objRecip = Nothing
            objNS = Nothing
            objolApp = Nothing

        End Try

    End Function

    'Envoie une demande de réunion et l'inscrit dans le calendrier choisi se trouvant dans outlook
    'liste des codes d'erreurs MAPI : http://support.microsoft.com/kb/238119/fr
    'l'appointment est défini comme entrée sortie afin de lui alouer l'identifiant outlook
    Public Function SendMeetingRequest_CalendarSelected(ByVal compte As CompteInformatique, _
                                                        ByRef myAppt As Appointment)

        Dim objolApp As Outlook.Application = New Outlook.Application
        Dim objNS As Outlook.NameSpace
        Dim objRecip As Outlook.Recipient
        Dim objFolder As Outlook.MAPIFolder
        Dim objAppt As Outlook.AppointmentItem
        Dim objExcep As Outlook.Exception
        'Dim objAppt As Outlook.MeetingItem
        Dim strName As String

        ' ### name or email address of person whose Calendar you want to use ###
        'strName = "mailorganizer@forchooseCalendar.com"
        strName = compte.Mail

        'Get MAPI NameSpace
        objNS = objolApp.GetNamespace("MAPI")

        Try
            objRecip = objNS.CreateRecipient(strName)
            objRecip.Resolve()

            'Vérification de l'existance du calendrier de l'organisateur désiré
            If objRecip.Resolved Then
                objFolder = objNS.GetSharedDefaultFolder(objRecip, Outlook.OlDefaultFolders.olFolderCalendar)
                objAppt = objFolder.Items.Add(Outlook.OlItemType.olAppointmentItem)

                With objAppt
                    .Start = myAppt.TimeStart ' DateAdd("d", 1, System.DateTime.Now)
                    '.Duration = 30
                    .End = myAppt.TimeEnd

                    .Subject = myAppt.Subject ' "Test   " & FormatDateTime(System.DateTime.Now, DateFormat.ShortTime)
                    .Body = myAppt.Description ' "hello world"
                    .Location = myAppt.Location '"sam world"
                    .ReminderSet = True
                    .ReminderMinutesBeforeStart = myAppt.Reminder.Minute ' 5
                    Select Case myAppt.StatusBusy.ToUpper
                        Case "FREE"
                            .BusyStatus = Outlook.OlBusyStatus.olFree
                        Case "OUTOFOFFICE"
                            .BusyStatus = Outlook.OlBusyStatus.olOutOfOffice
                        Case "TENTATIVE"
                            .BusyStatus = Outlook.OlBusyStatus.olTentative
                        Case "BUSY"
                            .BusyStatus = Outlook.OlBusyStatus.olBusy
                        Case Else
                            .BusyStatus = Outlook.OlBusyStatus.olBusy
                    End Select
                    .AllDayEvent = False
                    Select Case myAppt.StatusMeeting.ToUpper
                        Case "CONFIRMED"
                            .MeetingStatus = Outlook.OlMeetingStatus.olMeeting
                        Case "CANCELED"
                            .MeetingStatus = Outlook.OlMeetingStatus.olMeetingCanceled
                        Case "RECEIVED"
                            .MeetingStatus = Outlook.OlMeetingStatus.olMeetingReceived
                        Case "RECEIVEDANDCANCELED"
                            .MeetingStatus = Outlook.OlMeetingStatus.olMeetingReceivedAndCanceled
                        Case "NONMEETING"
                            .MeetingStatus = Outlook.OlMeetingStatus.olNonMeeting
                        Case Else
                            .MeetingStatus = "error"
                    End Select
                    '.Save()
                End With

                If myAppt.Periodicity = True Then
                    'recurring meeting
                    Dim myPattern As Outlook.RecurrencePattern = objAppt.GetRecurrencePattern
                    myPattern.RecurrenceType = Outlook.OlRecurrenceType.olRecursWeekly
                    myPattern.Interval = 1
                    Select Case myAppt.Wkst
                        Case "MO"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olMonday
                        Case "TH"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olThursday
                        Case "WE"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olWednesday
                        Case "TH"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olThursday
                        Case "FR"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olFriday
                        Case "SA"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olSaturday
                        Case "SU"
                            myPattern.DayOfWeekMask = Outlook.OlDaysOfWeek.olSunday
                        Case Else
                            myPattern.DayOfWeekMask = "error"
                    End Select
                    myPattern.PatternStartDate = myAppt.TimeStart ' #1/15/2009#
                    myPattern.PatternEndDate = myAppt.Until ' #2/15/2009#

                    'Delete the individual appointment (exception days)
                    objAppt.Save()
                    Dim itemDelete As Outlook.AppointmentItem
                    For Each myexdate As ExdateClass In myAppt.Exdate

                        itemDelete = myPattern.GetOccurrence(New Date(myexdate.Exdate.Year, myexdate.Exdate.Month, myexdate.Exdate.Day, _
                                                                          myAppt.TimeStart.Hour, myAppt.TimeStart.Minute, myAppt.TimeStart.Second))
                        If itemDelete IsNot Nothing Then
                            itemDelete.Delete()
                        End If

                    Next
                End If

                'Add required attendees
                Dim objRecipts As Outlook.Recipients = objAppt.Recipients

                If myAppt.AttendeesReqList <> "" Then
                    For Each myParticipant As Participant In myAppt.AttendeesReq
                        'objRecip = objRecipts.Add("mailrequest@attendee.com")
                        objRecip = objRecipts.Add(myParticipant.Mail)
                        objRecip.Type = Outlook.OlMeetingRecipientType.olRequired
                    Next
                End If

                '' Add optional attendee.
                If myAppt.AttendeesOptList <> "" Then
                    For Each myParticipant As Participant In myAppt.AttendeesOpt
                        'objRecip = objRecipts.Add("UserTest2") ' TODO:
                        objRecip = objRecipts.Add(myParticipant.Mail)
                        objRecip.Type = Outlook.OlMeetingRecipientType.olOptional
                    Next
                End If

                '' Add resources attendee.
                If myAppt.AttendeesRessList <> "" Then
                    For Each myParticipant As Participant In myAppt.AttendeesRess
                        'objRecip = objRecipts.Add("UserTest2") ' TODO:
                        objRecip = objRecipts.Add(myParticipant.Mail)
                        objRecip.Type = Outlook.OlMeetingRecipientType.olResource
                    Next
                End If

                objRecipts.ResolveAll()

                objAppt.Save() 'must be save befor send to send also the recurring meetings

                objAppt.Send()
                myAppt.UIDoutlook = objAppt.EntryID
            End If

            Return True

        Catch ex As System.Runtime.InteropServices.COMException
            Select Case ex.ErrorCode
                Case -2147467260    ' User responded NO to security prompt
                    MessageBox.Show("It won't work unless you say Yes to the security prompt.")
                Case -1767636707    ' store not available to GetSharedDefaultFolder
                    MessageBox.Show("Information store for " & objRecip.Name & " not available.")
                Case -1664876273    ' no permissions for folder
                    MessageBox.Show("You do not have permission to view the folder.")
                Case -632274939     ' read-only permission, cannot write
                    MessageBox.Show("You do not have permission to create a new item in the folder.")
                Case -2147221219
                    MessageBox.Show("The calendar of """ & strName & """ don't exist.")
                Case Else
                    MessageBox.Show("COMException - " & ex.ErrorCode)
            End Select
            Return False

        Catch ex As Exception
            MessageBox.Show(ex.Message, ex.ToString)
            Return False

        Finally
            objFolder = Nothing
            objAppt = Nothing
            objRecip = Nothing
            objNS = Nothing
            objolApp = Nothing

        End Try

    End Function

Conclusion :


SI VOUS AVEZ DES INFOS AU SUJET DES MISES à JOURS, JE SUIS PRENEUR!

A voir également

S'inscrire maintenant

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.