Synchroniser les rendez-vous entre Access et Outlook

Denis Hulo

Objectif : apprendre à créer un outil Access permettant de synchroniser les rendez-vous entre Access et Outlook.

Niveau requis : avancé.

Commentez cet article : Commentez

- Titre : Synchroniser les rendez-vous entre Access et Outlook

- Auteur : Denis Hulo

- Parution : 2 mai 2018

- Public visé :

- Licence : Copyright ® 2018 Denis Hulo. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- I. Introduction

- II. La base de données Access

- II-A. Table T_RendezVous

- II-B. Table T_CalendrierOutlook

- III. Les rendez-vous Outlook

- III-A. Objet AppointmentItem

- IV. Opérations réalisées

- IV-A. Opérations d'importation

- IV-B. Opérations d'exportation

- IV-C. Opérations de suppression

- V. Formulaire F_ListeRendezVous

- V-A. Bouton de commande cmdImportRendezVous

- V-B. Bouton de commande cmdExportRendezVous

- V-C. Filtrage des rendez-vous

- V-C-1. Procédure RefreshListeRendezVous

- V-D. Bouton de commande CmdActualiser

- V-E. Bouton de commande CmdInitialiserLiens

- VI. Formulaire F_RendezVous

- VI-A. Bouton de commande cmdValiderRendezVous

- VI-B. Bouton de commande cmdSupprimerRendezVous

- VI-C. Liste déroulante cmbCalendrierOutlook

- VII. Module M_RendezVous

- VII-A. Fonction WeekEndJourFerie

- VII-B. Fonction JourConge

- VII-C. Fonction isOutLookRunning

- VII-D. Procédure RunOutlook

- VII-E. Fonction Evaluer

- VII-F. Procédure générique AddRendezVousOutlook

- VII-G. Procédure générique UpdateRendezVousAccess

- VII-H. Procédure générique UpdateRendezVousOutlook

- VII-I. Fonction ImportRendezVous

- VII-J. Fonction ExportRendezVous

- VII-K. Fonction InitialiserLiens

- VII-L. Fonction MajRendezVous

- VII-M. Fonction SupprimerRendezVousOutlook

- VII-N. Fonction MajCalendriersOutlook

- VIII. Les bases de données à télécharger

- IX. Remerciements

I - Introduction

Après avoir décrit la structure des tables Access et de l'objet AppointmentItem d'Outlook, on présentera à l'aide de schémas, les différentes opérations permettant de synchrnoniser les rendez-vous entre Access et Outlook :

- opérations d'importation ;

- opérations d'exportation ;

- Opérations de suppression.

Ensuite, on détaillera la structure des différents formulaires et le code VBA de l'application exemple.

Affichage du formulaire

Formulaire F_ListeRendezVous

Le code VBA présenté dans cet article utilise la méthode de liaison appelée early binding qui nécessite de cocher la référence Microsoft Outlook xx.x Object Library. Pour éviter les conflits de version au niveau de la référence Outlook, une version 1.2 en late binding, est aussi disponible en téléchargement.

II - La base de données Access

Nous aurons besoin tout d'abord d'enregistrer dans des tables les informations concernant les rendez-vous et les calendriers Outlook.

II-A - Table T_RendezVous

Table permettant d'enregistrer les différents rendez-vous dans Access.

T_RendezVous

Nom du champ

Type du champ

Description

IdRendezVous

Entier long

Numéro identifiant le rendez-vous

Objet

Texte

Objet du rendez-vous

Emplacement

Texte

Emplacement du rendez-vous

Note

Texte

Note ou commentaire sur le rendez-vous

Categorie

Texte

Type ou catégorie du rendez-vous : Réunion, Congé…

DateDebut

Date/Heure

Date de début du rendez-vous

HeureDebut

Date/Heure

Heure de début du rendez-vous

DateFin

Date/Heure

Date de fin du rendez-vous

HeureFin

Date/Heure

Heure de fin du rendez-vous

IdCalendrierOutlook

Texte

Identifiant du calendrier Outlook du rendez-vous

IdRendezVousOutlook

Texte

Identifiant du rendez-vous Outlook

…

…

…

Ce sont les champs principaux de cette table. Pour simplifier les choses, on ne présentera pas ceux permettant de gérer les rendez-vous périodiques.

II-B - Table T_CalendrierOutlook

Table permettant d'enregistrer les différents calendriers de rendez-vous Outlook.

T_CalendrierOutlook

Nom du champ

Type du champ

Description

IdCalendrier

Texte

Identifiant du calendrier de rendez-vous Outlook

NomCalendrier

Texte

Nom du calendrier de rendez-vous Outlook

DossierParent

Texte

Nom du dossier contenant le calendrier

III - Les rendez-vous Outlook

Nous présentons ici un résumé de la structure de l'objet AppointmentItem permettant de gérer les rendez-vous côté Outlook.

III-A - Objet AppointmentItem

Objet Outlook permettant d'enregistrer les rendez-vous, il est un élément d'un dossier Calendrier (Objet Folder). Voici un extrait de ses propriétés :

Objet AppointmentItem

Nom du champ

Type du champ

Description

EntryID

Texte

Champ identifiant, lié au champ IDRendezVousOutlook de la table Access

Subject

Texte

Objet du rendez-vous

Location

Texte

Emplacement du rendez-vous

Body

Texte

Notes sur le rendez-vous

Categories

Texte

Catégorie du rendez-vous

Start

Date/Heure

Date et heure du début du rendez-vous

End

Date/Heure

Date et heure de fin du rendez-vous

…

…

…

Pour ajouter un rendez-vous dans Outlook, on utilise l'objet Application du modèle Outlook :

Set objAppointment = objApp.CreateItem(olAppointmentItem)

Pour éditer et sauvegarder les informations dans un objet, on peut faire :

objAppointment.Subject = "Rendez-vous avec M. Duty"
...
objAppointment.save

La propriété EntryID va nous permettre de faire le lien avec le champ IdRendezVousOutlook de la table Access.

IV - Opérations réalisées

Pour mieux comprendre le principe, illustrons par des schémas les opérations d'importation, d'exportation et de suppression des données.

Ces schémas sont valables pour un seul compte de messagerie. L'adresse e-mail du compte de messagerie doit d'ailleurs être enregistrée dans la table T_CompteMessagerie.

IV-A - Opérations d'importation

On vérifie si le rendez-vous Outlook est présent dans la base Access, et si c'est le cas, on le met à jour côté Access, sinon on l'ajoute :

Mise à jour du rendez-vous

Ajout du rendez-vous

IV-B - Opérations d'exportation

On vérifie si le rendez-vous enregistré dans la table Access est présent dans la base Outlook, et si c'est le cas, on le met à jour côté Outlook, sinon on l'ajoute :

Mise à jour du rendez-vous

Ajout du rendez-vous

IV-C - Opérations de suppression

Si le rendez-vous est présent dans Access et Outlook, on le supprime des deux côtés, sinon on le supprime uniquement où il est présent :

Suppression des deux côtés

Suppression dans Access

V - Formulaire F_ListeRendezVous

Il permet d'afficher la liste des rendez-vous en fonction d'une période. Il contient également les deux boutons de commandes permettant d'importer ou d'exporter les rendez-vous compris dans une certaine période.

Formulaire F_ListeRendezVous

V-A - Bouton de commande cmdImportRendezVous

Ce bouton permet l'import, dans la base Access, des rendez-vous Outlook du ou des calendriers et compris dans la période définie sur le formulaire, en remplaçant ceux ayant le même identifiant.

Bouton cmdImportRendezVous

Déroulé de la procédure événementielle

- On importe les rendez-vous Outlook du ou des calendriers et selon la période choisie.

- On met à jour la liste des calendriers Outlook enregistrés dans la table T_CalendrierOutlook.

- On actualise le sous-formulaire.

Procédure événementielle CmdImportRendezVous_Click

Private Sub CmdImportRendezVous_Click()
' Exécute l'importation des rendez-vous Outlook
On Error GoTo Err_CmdImportRendezVous_Click

' Si l'utilisateur ne souhaite pas importer les rendez-vous, on sort
If MsgBox("Souhaitez-vous importer les rendez-vous Outlook et les mettre à jour dans la base ?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

If ImportRendezVous Then ' On importe les rendez-vous Outlook en fonction des choix effectués sur le formulaire
' Si l'import a bien eu lieu
MajCalendriersOutlook ' On met à jour la liste des dossiers Outlook dans la base Access
Me.Refresh ' Actualisation des listes de choix et de la liste des rendez-vous

MsgBox ("L'importation des rendez-vous a été réalisée avec succès !") ' Affichage du message de succès
End If

Err_CmdImportRendezVous_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
End If

End Sub

V-B - Bouton de commande cmdExportRendezVous

Ce bouton permet l'export, dans Outlook, des rendez-vous compris dans une période, en remplaçant ceux ayant le même identifiant.

Bouton cmdExportRendezVous

Déroulé de la procédure événementielle

- On exporte dans Outlook les rendez-vous du ou des calendriers Outlook et compris dans la période choisie.

- Si l'exportation s'est bien déroulée, on le signale.

Procédure événementielle CmdExportRendezVous_Click

Private Sub CmdExportRendezVous_Click()
' Exécute l'exportation des rendez-vous dans Outlook
On Error GoTo Err_CmdExportRendezVous_Click

' Si l'utilisateur ne souhaite pas exporter les rendez-vous, on sort
If MsgBox("Souhaitez-vous exporter les rendez-vous de la base et les mettre à jour dans Outlook ?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

If ExportRendezVous Then ' On exporte les rendez-vous dans Outlook en fonction des choix effectués
'Si l'export a réussi
MsgBox ("L'exportation des rendez-vous a été réalisée avec succès !") ' Affichage du message de succès
End If

Err_CmdExportRendezVous_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
End If

End Sub

V-C - Filtrage des rendez-vous

Une liste déroulante permet de choisir un calendrier Outlook pour afficher les rendez-vous de ce dossier dans le sous-formulaire Access.

cmbDossierOutlook

Des zones de texte permettent de saisir une période pour filtrer les rendez-vous dans le sous-formulaire Access.

Période de filtrage

V-C-1 - Procédure RefreshListeRendezVous

Déroulé de la procédure

- Définition du critère de la requête en fonction de la période saisie.

- Constitution de la chaîne SQL avec le critère précédent.

- Affectation de la chaîne SQL à la source du sous-formulaire.

Public Sub RefreshListeRendezVous()
' Permet de filtrer les rendez-vous en fonction du calendrier choisi et de la période définie sur le formulaire
Dim sSQL As String
Dim sWhere As String

' Définition du critère de filtrage des rendez-vous en fonction du calendrier choisi et de la date de début et de fin
sWhere = " (DateFin >= #" & Format(Nz(Me!DateDebut, #1/1/1000#), "mm/dd/yyyy") & "#) and (DateDebut<=#" & Format(Nz(Me!DateFin, #1/1/4000#), "mm/dd/yyyy") & "#)"

If (Nz(Me.cmbDossierOutlook, "") <> "[Tous]") And (Nz(Me.cmbDossierOutlook, "") <> "") Then
' Si un calendrier a été choisi dans la liste
sWhere = sWhere & " and IdCalendrierOutlook like '" & Me.cmbDossierOutlook.Value & "'"
Else
Me.cmbDossierOutlook = "[Tous]"
End If

' Constitution de la chaîne SQL
sSQL = "Select * From R_ListeRendezVous where" & sWhere & " order by [DateDebut] asc, HeureDebut Asc;"

' Affectation de la chaîne SQL à la propriété RecordSource du sous-formulaire
Me.SF_ListeRendezVous.Form.RecordSource = sSQL

End Sub

V-D - Bouton de commande CmdActualiser

Ce bouton permet d'actualiser le formulaire.

Bouton cmdActualiser

Déroulé de la procédure événementielle

- On met à jour la liste des calendriers Outlook enregistrés dans la table T_CalendrierOutlook.

- On rafraîchit le formulaire et les listes déroulantes.

Procédure événementielle CmdActualiser_Click

Private Sub CmdActualiser_Click()
' Procédure d'actualisation du formulaire et de ses listes
On Error GoTo Err_CmdActualiser_Click

' Si l'utilisateur ne souhaite pas actualiser le contact, on sort
If MsgBox("Souhaitez-vous actualiser le formulaire Access ?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook
MsgBox ("Ouverture d'Outlook !")
End If

MajCalendriersOutlook ' On met a jour la liste des calendriers Outlook

Me.Refresh ' On actualise le formulaire

' Partie gestion de l'erreur
Err_CmdActualiser_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Description de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
End If
End Sub

V-E - Bouton de commande CmdInitialiserLiens

Ce bouton permet, en cas de changement d'ordinateur ou de récupération des données Outlook à partir du fichier .pst, de mettre à jour les liens entre le champ IdRendezVousOutlook de la base Access et la propriété EntryID des rendez-vous Outlook.

Bouton cmdInitialiserLiens

Déroulé de la procédure événementielle

- Si le rendez-vous Outlook est dans la base Access, on met à jour le champ IdRendezVousOutlook côté Access.

- On actualise le sous-formulaire formulaire.

- On rafraîchit la liste des calendriers Outlook enregistrés dans la table T_CalendrierOutlook.

Procédure événementielle CmdInitialiserLiens_Click

Private Sub CmdInitialiserLiens_Click()
' Exécute de la procédure d'initialisation des liens en cas de changement d'ordinateur
On Error GoTo Err_CmdInitialiserLiens_Click

' Si l'utilisateur souhaite initialiser les liens entre Access et Outlook
If MsgBox("Souhaitez-vous initialiser les liens ?", vbYesNo + vbQuestion) = vbYes Then
If InitialiserLiens Then
' Si l'initialisation des liens a bien eu lieu
MajCalendriersOutlook ' On met à jour la liste des dossiers Outlook dans la base Access
Me.SF_ListeRendezVous.Requery ' On rafraîchit la source du sous-formulaire
MsgBox ("L'initialisation des liens a été réalisée avec succès !") ' Affichage du message de succès
End If
End If

Err_CmdInitialiserLiens_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
End If

End Sub

VI - Formulaire F_RendezVous

Il permet de modifier, d'ajouter ou supprimer un rendez-vous. Il comprend les deux boutons de commandes permettant de valider ou supprimer le rendez-vous actif.

Formulaire F_RendezVous

Ce formulaire s'ouvre en mode édition en double-cliquant sur une ligne précise de la liste des rendez-vous, et en mode ajout, en cliquant sur le bouton « Ajouter un rendez-vous » situé dans l'en-tête du formulaire F_ListeRendezVous.

VI-A - Bouton de commande cmdValiderRendezVous

Ce bouton permet d'enregistrer les modifications effectuées dans le formulaire F_RendezVous, puis d'exporter le rendez-vous dans Outlook.

Bouton cmdValiderRendezVous

Déroulé de la procédure événementielle

- On enregistre le rendez-vous dans Access.

- On met à jour la liste des rendez-vous dans le formulaire F_ListeRendezVous.

- On exporte le rendez-vous dans Outlook.

- On ferme le formulaire pour revenir sur la liste des rendez-vous.

Procédure événementielle cmdValiderRendezVous_Click

Private Sub CmdValiderRendezVous_Click()
' Exécute l'enregistrement du rendezVous côté Access et Outlook
On Error GoTo Err_CmdValiderRendezVous_Click
Dim dt1 As Date, dt2 As Date

' Si l'utilisateur ne souhaite enregistrer le rendez-vous, on sort
If MsgBox("Souhaitez-vous enregistrer ce rendez-vous et le mettre à jour dans Outlook ?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

If (Me.IdCalendrierOutlook.Value <> "") Then ' Si un calendrier Outlook a été choisi sur le formulaire

dt1 = CDate(Me.DateDebut): dt2 = CDate(Me.DateFin)

If (Not JourConge(Me.IdCalendrierOutlook, dt1, dt2)) And (Not (WeekEndJourFerie(dt1, dt2)) Or (Me.Categorie = "Congé")) Then
' Si la période ne comprend pas de jour de congé et, s'il n'y a pas non plus de jour férié ou si la saisie concerne un congé

Me.Refresh ' On enregistre le rendez-vous dans Access

If MajRendezVous(Me.IdCalendrierOutlook.Value) Then ' On exporte le rendez-vous dans Outlook
'Si l'export a réussi
Form_F_ListeRendezVous.RefreshListeRendezVous ' On rafraîchit la liste des rendez-vous
DoCmd.Close acForm, Me.Name ' On ferme le formulaire
MsgBox ("L'exportation du rendez-vous a été réalisée avec succès !") ' Affichage du message de succès
Else
MsgBox Me.IdCalendrierOutlook.Value
End If

Else ' Sinon
MsgBox ("Période comprenant des jours de congé ou fériés !")
End If

Else ' Si aucun calendrier Outlook n'a été choisi sur le formulaire
MsgBox ("Choisir un calendrier de rendez-vous Outlook et une heure de début et de fin !")
End If

Err_CmdValiderRendezVous_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
End If

End Sub

VI-B - Bouton de commande cmdSupprimerRendezVous

Ce bouton permet de supprimer le rendez-vous dans Outlook et Access et de mettre à jour la liste des rendez-vous.

Bouton cmdSupprimerRendezVous

Ce formulaire s'ouvre en mode édition en double-cliquant sur une ligne précise de la liste des rendez-vous, et en mode ajout, en cliquant sur le bouton « Ajouter un rendez-vous » dans le formulaire F_ListeRendezVous.

Déroulé de la procédure événementielle

- On supprime le rendez-vous dans Outlook.

- On supprime le rendez-vous dans Access.

- On met à jour la liste des rendez-vous dans le formulaire F_ListeRendezVous.

- On ferme le formulaire pour revenir sur la liste des rendez-vous.

Procédure événementielle cmdSupprimerRendezVous_Click

Private Sub CmdSupprimerRendezVous_Click()
' Procédure de suppression du rendez-vous actif
On Error GoTo Err_CmdSupprimerRendezVous_Click

If MsgBox("Souhaitez-vous supprimer ce rendez-vous ?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If

If Nz(Me.IdRendezVousOutlook, "") <> "" Then
If SupprimerRendezVousOutlook(Me.IdRendezVousOutlook) Then ' On lance la suppression dans Outlook
' Si la suppression a bien été effectuée
MsgBox ("Rendez-vous supprimé dans Outlook !") ' On affiche un message de succès
End If
End If

' On supprime le rendez-vous dans Access
DoCmd.SetWarnings False ' Désactivation des alertes
DoCmd.RunSQL "delete * from T_RendezVous where IdRendezVous=" & Nz(Me.IdRendezVous, 0) ' Exécution de la requête suppression
DoCmd.SetWarnings True

Form_F_ListeRendezVous.RefreshListeRendezVous ' On rafraîchit la liste des rendez-vous

DoCmd.Close acForm, Me.Name ' On ferme le formulaire

Err_CmdSupprimerRendezVous_Click:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Description, vbCritical, "Une erreur a eu lieu !"
DoCmd.SetWarnings True
End If

End Sub

VI-C - Liste déroulante cmbCalendrierOutlook

Elle permet de saisir un dossier Outlook pour le rendez-vous enregistré dans Access.

Elle est alimentée par la table T_CalendrierOutlook qui permet d'enregistrer les noms des dossiers Outlook.

Liste déroulante CalendrierOutlook

VII - Module M_RendezVous

On s'arrange pour regrouper dans des procédures ou fonctions génériques les portions de code répétitives, pour ainsi rendre le code plus lisible et faciliter sa maintenance. Ces routines seront ensuite appelées dans les procédures principales.

VII-A - Fonction WeekEndJourFerie

Elle permet de tester, au moment de valider un rendez-vous, si la période saisie comprend un samedi/dimanche ou un jour férié. Elle utilise la fonction EstFerie prise dans la FAQ Access, avec notamment le calcul du lundi de Pâques suivant la méthode de Thomas O'Beirne.

Fonction WeekEndJourFerie

Function WeekEndJourFerie(DateDebut As Date, DateFin As Date, _
Optional Ferie As Boolean = True) As Boolean
' Teste si la période comprise entre la date de début et de fin contient un jour férié ou un samedi/dimanche.
Dim dt As Date

dt = DateDebut ' Copie de la date de début dans la variable
WeekEndJourFerie = False
While dt <= DateFin ' Parcours des dates comprises entre DateDebut et DateFin
If (DatePart("w", dt, vbMonday) >= 6) Or IIf(Ferie, EstFerie(dt), False) Then
' Si c'est un jour férié ou un week-end
WeekEndJourFerie = True
End If
dt = DateAdd("d", 1, dt) ' Prochaine date
Wend

End Function

VII-B - Fonction JourConge

Elle permet de tester, au moment de valider un rendez-vous, si la période saisie comprend un jour de congé. Les congés sont enregistrés dans la table des rendez-vous avec pour catégorie « Congé ».

Fonction JourConge

Function JourConge(ByVal IdCalendrierOutlook As String, ByVal DateDebut As Date, ByVal DateFin As Date) As Boolean
' La fonction teste, pour un calendrier, si les dates de début et de fin chevauchent un congé.
JourConge = Not IsNull(DLookup("IdRendezVous", "T_RendezVous", "(Categorie like 'Congé') and (IdCalendrierOutlook like '" & IdCalendrierOutlook & "')" & _
" and (DateDebut<=#" & Format(DateFin, "mm-dd-yyyy") & "#) and (DateFin>=#" & Format(DateDebut, "mm-dd-yyyy") & "#)"))

End Function

VII-C - Fonction isOutLookRunning

Cette fonction teste si Outlook est ouvert ou pas :

Fonction isOutLookRunning

Public Function IsOutLookRunning() As Boolean
On Error Resume Next
Dim objOutLook As Object

'Référence vers l'objet Application Outlook
Set objOutLook = GetObject(, "OutLook.Application")

'Si outlook n'est pas ouvert
If (Err <> 0) Then
IsOutLookRunning = False
Else
IsOutLookRunning = True
End If

Set objOutLook = Nothing

End Function

VII-D - Procédure RunOutlook

Procédure de lancement d'Outlook.

Procédure RunOutlook

Public Sub RunOutlook()
' Lancement d'Outlook
Dim oShell As Object

Set oShell = CreateObject("WScript.Shell")
oShell.Run "outlook" ' On ouvre Outlook
Set oShell = Nothing

End Sub

VII-E - Fonction Evaluer

Elle nous permet de gérer les cas où la valeur du champ ou de la propriété est nulle.

Fonction Evaluer

Public Function Evaluer(fieldvalue As Variant) As Variant
Dim s As String

s = Nz(fieldvalue, "")

If s <> "" Then
Evaluer = s
End If

End Function

VII-F - Procédure générique AddRendezVousOutlook

Elle permet d'ajouter le rendez-vous Outlook dans la table Access, et prend en argument le Recordset basé sur la table des rendez-vous, l'objet AppointmentItem du rendez-vous Outlook, et son dossier.

Procédure AddRendezVousOutlook

Public Sub AddRendezVousOutlook(rs As DAO.Recordset, objAppointment As Outlook.AppointmentItem, objFolder As Outlook.Folder)
' procédure d'ajout du rendez-vous Outlook dans Access
Dim objRecurrPatt As RecurrencePattern

With rs

.AddNew ' On ajoute de rendez-vous dans la base Access

!Objet = Evaluer(objAppointment.Subject)

!Emplacement = Evaluer(objAppointment.Location)

!Categorie = Evaluer(objAppointment.Categories)

!DateDebut = DateValue(objAppointment.Start)
!HeureDebut = TimeValue(objAppointment.Start)

!DateFin = DateValue(objAppointment.End)
!HeureFin = TimeValue(objAppointment.End)

!Note = Evaluer(objAppointment.Body)

!IdCalendrierOutlook = objFolder.EntryID ' On copie dans le champ Access l'identifiant du calendrier Outlook
!IdRendezVousOutlook = objAppointment.EntryID ' On copie dans le champ Access l'identifiant du rendez-vous Outlook

If objAppointment.IsRecurring Then ' Si c'est un rendes-vous périodique

Set objRecurrPatt = objAppointment.GetRecurrencePattern ' Référence à l'objet qui gère la périodicité

' Mise à jour des champs utilisés pour gérer la récurrence dans Access
!TypeRecurrence = objRecurrPatt.RecurrenceType
!DebutRecurrence = objRecurrPatt.PatternStartDate
!FinRecurrence = objRecurrPatt.PatternEndDate
!OccurrencesRecurrence = OccurrencesRdvPeriodique(objRecurrPatt)
!IntervalleRecurrence = objRecurrPatt.Interval
!EstRecurrent = True

Set objRecurrPatt = Nothing ' on libère la variable

' Ajout des indices des récurrences du rendez-vous dans la table T_IndiceRecurrence
AddRecurrences objAppointment.EntryID, !OccurrencesRecurrence

End If

.Update ' Enregistrement du rendez-vous dans la table

.MoveLast

objAppointment.BillingInformation = Evaluer(!IdRendezVous)
objAppointment.Save

End With

End Sub

VII-G - Procédure générique UpdateRendezVousAccess

Elle permet de mettre à jour le rendez-vous côté Access avec les données du rendez-vous Outlook. Elle prend en argument le Recordset basé sur la table Access, l'objet AppointmentItem du rendez-vous Outlook, et son dossier.

Procédure UpdateRendezVousAccess

Public Sub UpdateRendezVousAccess(rs As DAO.Recordset, objAppointment As Outlook.AppointmentItem, objFolder As Outlook.Folder)
' procédure de mise à jour du rendez-vous dans Access
Dim objRecurrPatt As RecurrencePattern

With rs

.Edit ' On met à jour ce rendez-vous avec les infos de Outlook

!Objet = Evaluer(objAppointment.Subject)

!Emplacement = Evaluer(objAppointment.Location)

!Categorie = Evaluer(objAppointment.Categories)

!DateDebut = DateValue(objAppointment.Start)
!HeureDebut = TimeValue(objAppointment.Start)

!DateFin = DateValue(objAppointment.End)
!HeureFin = TimeValue(objAppointment.End)

!Note = Evaluer(objAppointment.Body)

!IdCalendrierOutlook = objFolder.EntryID ' On copie dans le champ Access l'identifiant du Calendrier Outlook
!IdRendezVousOutlook = objAppointment.EntryID ' On copie dans le champ Access l'identifiant du rendez-vous Outlook

If objAppointment.IsRecurring Then ' Si c'est un rendes-vous périodique

Set objRecurrPatt = objAppointment.GetRecurrencePattern ' Référence à l'objet qui gère la périodicité

' Mise à jour des champs utilisés pour gérer la récurrence dans Access
!TypeRecurrence = objRecurrPatt.RecurrenceType
!DebutRecurrence = objRecurrPatt.PatternStartDate
!FinRecurrence = objRecurrPatt.PatternEndDate
!OccurrencesRecurrence = OccurrencesRdvPeriodique(objRecurrPatt)
!IntervalleRecurrence = objRecurrPatt.Interval
!EstRecurrent = True

' Ajout des indices des récurrences du rendez-vous dans la table T_IndiceRecurrence
AddRecurrences objAppointment.EntryID, !OccurrencesRecurrence

Set objRecurrPatt = Nothing ' on libère la variable

End If

.Update ' Enregistrement du rendez-vous dans la table

objAppointment.BillingInformation = Evaluer(!IdRendezVous)
objAppointment.Save

End With

End Sub

VII-H - Procédure générique UpdateRendezVousOutlook

Elle permet de mettre à jour le rendez-vous Outlook avec les données du rendez-vous enregistré dans la table Access. Elle prend en argument le Recordset basé sur la table Access, l'objet AppointmentItem du rendez-vous Outlook, et l'objet NameSpace.

Procédure UpdateRendezVousOutlook

Public Sub UpdateRendezVousOutlook(objAppointment As Outlook.AppointmentItem, rs As DAO.Recordset, objSpace As Outlook.NameSpace)
' Procédure de mise à jour du rendez-vous Outlook
Dim dt As Date, id As String
Dim objAppointment2 As Outlook.AppointmentItem
Dim objFolder As Outlook.Folder

With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous

.Subject = Evaluer(rs!Objet)

.Location = Evaluer(rs!Emplacement)

.Categories = Evaluer(rs!Categorie)

.Start = Evaluer(CDate(rs!DateDebut) + CDate(rs!HeureDebut))
.End = Evaluer(CDate(rs!DateFin) + CDate(rs!HeureFin))

.Body = Evaluer(rs!Note)
.BillingInformation = Evaluer(rs!IdRendezVous)

.ReminderSet = False

.BillingInformation = Evaluer(rs!IdRendezVous)

.Save ' Sauvegarde des modifications dans le rendez-vous Outlook

Set objFolder = objSpace.GetFolderFromID(rs!IdCalendrierOutlook)
id = .EntryID

If objFolder.Name <> .Parent.Name Then
Set objAppointment2 = .Move(objFolder) ' Déplacement du rendez-vous dans le bon Calendrier
id = objAppointment2.EntryID
End If

rs.Edit
rs!IdRendezVousOutlook = id
rs.Update

End With

'Fermeture et libérations des variables
Set objAppointment2 = Nothing
Set objFolder = Nothing

End Sub

VII-I - Fonction ImportRendezVous

Déroulé de la fonction

- On teste si Outlook est ouvert et on l'ouvre si ce n'est pas le cas.

- On crée l'objet Application d'Outlook et on ouvre le Recordset basé sur la table des rendez-vous.

- On parcourt les dossiers et sous-dossiers Outlook à la recherche du ou des calendriers choisis.

- On liste les rendez-vous contenus dans ces dossiers.

- Pour chaque rendez-vous, s'il est présent dans la base, on le remplace, sinon on l'ajoute.

- On ferme et libère les variables.

On teste si Outlook est déjà ouvert :

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook ' On lance Outlook
End If

On crée les objets Application et NameSpace d'Outlook, la référence au compte de messagerie et à la base en cours, puis on ouvre le Recordset basé sur la table T_RendezVous :

' Création de l'objet Application d'Outlook
Set objApp = New Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier principal du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("email", "T_CompteMessagerie"))

' Référence à la base de données courante
Set db = CurrentDb

' Ouverture du recordset basé sur la table T_Appointment contenant les rendez-vous dans Access
Set rs = db.OpenRecordset("T_RendezVous", dbOpenDynaset)

dt1 = Nz(Forms!F_ListeRendezVous!DateDebut, #1/1/1000#) ' Date de début de la période sur le formulaire
dt2 = Nz(Forms!F_ListeRendezVous!DateFin, #1/1/4000#)   ' Date de fin de la période sur le formulaire
...

On parcourt les dossiers et sous-dossiers Outlook à la recherche de calendriers de rendez-vous, puis on liste les rendez-vous à la recherche de celui à importer :

dt1 = Nz(Forms!F_ListeRendezVous!DateDebut, #1/1/1000#) ' Date de début de la période sur le formulaire
dt2 = Nz(Forms!F_ListeRendezVous!DateFin, #1/1/4000#) ' Date de fin de la période sur le formulaire

' Copie dans la variable de l'identifiant du calendrier choisi sur le formulaire
IdCalendrierOutlook = Forms!F_ListeRendezVous!cmbDossierOutlook.value

' Dans le dossier principal du compte de messagerie
With objCptFolder

' On parcourt les dossiers contenus dans ce dossier principal
For Each objFolder In .Folders

If (objFolder.DefaultItemType = olAppointmentItem) Then ' Si c'est un calendrier de rendez-vous

' Si le dossier est celui choisi ou si on a choisi de tout importer
If (objFolder.EntryID = IdCalendrierOutlook) Or (IdCalendrierOutlook = "[Tous]") Then

Set objAppointments = objFolder.Items

For Each objAppointment In objAppointments ' Parcours de la liste des rendez-vous Outlook

' On teste si le rendez-vous est compris dans la période définie sur le formulaire
If (dt2 >= DateValue(objAppointment.Start)) And (dt1 <= DateValue(objAppointment.End)) Then
...

On teste pour chaque rendez-vous s'il est présent dans la table T_RendezVous, si c'est le cas on le met à jour, sinon on l'ajoute :

' Recherche dans la table T_RendezVous du rendez-vous ayant le même identifiant Outlook
rs.FindFirst "[IdRendezVousOutlook] = '" & objAppointment.EntryID & "'"

If rs.NoMatch Then ' Si aucun rendez-vous dans Access ne possède cet identifiant
' On ajoute le rendezVous Outlook dans Access
AddRendezVousOutlook rs, objAppointment, objFolder
Else ' Si un rendez-vous Access possède le même identifiant
' On met à jour le rendezVous Access
UpdateRendezVousAccess rs, objAppointment, objFolder
End If
...

Pour finir, on minimise la fenêtre Outlook pour revenir à la fenêtre Access, puis ferme et libère les variables :

'On minimise la fenêtre Outlook pour revenir sur Access
objApp.ActiveWindow.WindowState = 1
ImportRendezVous = True

Err_ImportRendezVous:
If (Err.Number <> 0) And Not ImportRendezVous Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
If Not (rs Is Nothing) Then
rs.Close
End If
Set rs = Nothing
Set db = Nothing
Set objAppointment = Nothing
Set objAppointments = Nothing
Set objFolder = Nothing
Set objCptFolder = Nothing
Set objSpace = Nothing
Set objApp = Nothing

VII-J - Fonction ExportRendezVous

Déroulé de la fonction

- On teste si Outlook est ouvert et on l'ouvre si ce n'est pas le cas.

- On crée les objets Application et NameSpace d'Outlook et on ouvre le Recordset en sélectionnant les rendez-vous correspondant aux choix effectués sur le formulaire.

- On parcourt le Recordset et recherche pour chaque rendez-vous dans Access celui ayant comme identifiant la valeur du champ IdRendezVousOutlook.

- Si on le trouve, on le remplace par celui de la base Access, sinon on l'ajoute dans Outlook.

- On ferme et libère les variables.

On teste si Outlook est déjà ouvert :

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook ' On lance Outlook
End If

On crée les objets Application et NameSpace d'Outlook, la référence au compte de messagerie et à la base en cours, puis on ouvre le Recordset en fonction des choix effectués sur le formulaire :

' Création de l'objet Application d'Outlook
Set objApp = New Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier principal du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("email", "T_CompteMessagerie"))

' Référence à la base de données courante
Set db = CurrentDb

' On va filtrer les données Access en fonction de la période et du calendrier choisis sur le formulaire
sWhere = "(nz(IdCalendrierOutlook,'')<>'') and (DateFin >= #" & Format(Nz(Forms!F_ListeRendezVous!DateDebut, #1/1/1000#), "mm/dd/yyyy") & "#) and (DateDebut<=#" & Format(Nz(Forms!F_ListeRendezVous!DateFin, #1/1/4000#), "mm/dd/yyyy") & "#)"

If (Nz(Forms!F_ListeRendezVous!cmbDossierOutlook, "") <> "[Tous]") And (Nz(Forms!F_ListeRendezVous!cmbDossierOutlook, "") <> "") Then
' Si un dossier a été choisi dans la liste
sWhere = sWhere & " and IdCalendrierOutlook like '" & Forms!F_ListeRendezVous!cmbDossierOutlook.value & "'"
End If

' Constitution de la chaîne SQL
sSQL = "Select * From T_RendezVous where " & sWhere & " order by [DateDebut] asc, HeureDebut Asc;"

' Ouverture du recordset
Set rs = db.OpenRecordset(sSQL, dbOpenDynaset)
...

Pour chaque enregistrement, on recherche le rendez-vous Outlook ayant comme identifiant la valeur du champ IdRendezVousOutlook :

Do Until rs.EOF ' On parcourt la liste des rendez-vous présents dans le recordset Access

IdRendezVousOutlook = Nz(rs!IdRendezVousOutlook, "") ' Identifiant du rendez-vous Outlook

On Error Resume Next
' Référence au rendez-vous Outlook ayant comme EntryID l'id Outlook dans Access
Set objAppointment = objSpace.GetItemFromID(IdRendezVousOutlook, objCptFolder.StoreID)
On Error GoTo Err_ExportRendezVous
...

Si le rendez-vous de l'enregistrement Access est présent dans le dossier Outlook, on le met à jour, sinon on l'ajoute dans la base Access :

If TypeName(objAppointment) = "Nothing" Then ' Si aucun rendez-vous n'a été trouvé
' On crée le rendez-vous Outlook
Set objAppointment = objApp.CreateItem(olAppointmentItem)
End If

' On met à jour le rendez-vous Outlook
UpdateRendezVousOutlook objAppointment, rs, objSpace
...

Pour finir, on minimise la fenêtre Outlook pour revenir à la fenêtre Access, puis ferme et libère les variables :

ExportRendezVous = True

'On minimise la fenêtre Outlook pour revenir sur Access
objApp.ActiveWindow.WindowState = 1

Err_ExportRendezVous:
If (Err.Number <> 0) And Not ExportRendezVous Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
If Not (rs Is Nothing) Then
rs.Close
End If
Set rs = Nothing
Set db = Nothing
Set objAppointment = Nothing
Set objAppointment2 = Nothing
Set objFolder = Nothing
Set objCptFolder = Nothing
Set objSpace = Nothing
Set objApp = Nothing

VII-K - Fonction InitialiserLiens

Déroulé de la fonction

- On teste si Outlook est ouvert et on l'ouvre si ce n'est pas le cas.

- On crée l'objet Application d'Outlook et on ouvre le Recordset basé sur la table des rendez-vous.

- On parcourt les dossiers et sous-dossiers Outlook à la recherche des dossiers de rendez-vous.

- On liste les rendez-vous contenus dans ces dossiers.

- Pour chaque rendez-vous, s'il est présent dans la base, on le met à jour.

- On ferme et libère les variables.

On teste si Outlook est déjà ouvert :

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook ' On lance Outlook
End If

On crée les objets Application et NameSpace d'Outlook, la référence au compte de messagerie et à la base en cours, puis on ouvre le Recordset basé sur la table T_RendezVous :

'' Création de l'objet Application d'Outlook
Set objApp = new Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier principal du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("email", "T_CompteMessagerie"))

' Référence à la base de données courante
Set db = CurrentDb

' Ouverture du recordset basé sur la table T_Appointment contenant les rendez-vous dans Access
Set rs = db.OpenRecordset("T_RendezVous", dbOpenDynaset)

On parcourt les dossiers et sous-dossiers Outlook à la recherche de dossiers de rendez-vous, puis on liste les rendez-vous à la recherche de celui à mettre à jour :

' Dans le dossier principal du compte de messagerie
With objCptFolder

' On parcourt les dossiers contenus dans ce dossier principal
For Each objFolder In .Folders

If (objFolder.DefaultItemType = olAppointmentItem) Then ' Si c'est un dossier de rendez-vous

Set objAppointments = objFolder.Items ' Référence à la liste des rendez-vous contenus dans le dossier

For Each objAppointment In objAppointments ' Parcours de la liste des rendez-vous Outlook
...

On teste pour chaque rendez-vous s'il est présent dans la table T_RendezVous, si c'est le cas on le met à jour :

' Recherche dans la table T_RendezVous du rendez-vous ayant le même identifiant Outlook
rs.FindFirst "[IdRendezVous] = " & IIf(objAppointment.BillingInformation = "", 0, objAppointment.BillingInformation)

If Not rs.NoMatch Then ' Si un Appointment dans Access possède cet identifiant

With rs

.Edit ' On met à jour cet Appointment avec les infos de Outlook

!IdCalendrierOutlook = objSubFolder.EntryID ' On copie dans le champ Access l'identifiant du dossier Outlook
!IdRendezVousOutlook = objAppointment.EntryID ' On copie dans le champ Access l'identifiant de l'Appointment Outlook

.Update ' Enregistrement de l'Appointment dans la table

End With

End If
...

Pour finir, on minimise la fenêtre Outlook pour revenir à la fenêtre Access, puis ferme et libère les variables :

'On minimise la fenêtre Outlook pour revenir sur Access
objApp.ActiveWindow.WindowState = 1
InitialiserLiens = True

Err_InitialiserLiens:
If (Err.Number <> 0) And Not InitialiserLiens Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
If Not (rs Is Nothing) Then
rs.Close
End If
Set rs = Nothing
Set db = Nothing
Set objAppointment = Nothing
Set objAppointments = Nothing
Set objSubFolder = Nothing
Set objFolder = Nothing
Set objApp = Nothing

VII-L - Fonction MajRendezVous

Déroulé de la fonction

- On teste si Outlook est ouvert et on l'ouvre si ce n'est pas le cas.

- On crée les objets Application et NameSpace d'Outlook et on ouvre le Recordset basé sur la table T_RendezVous filtrée sur le rendez-vous actif.

- On recherche le rendez-vous dans Outlook.

- S'il est présent, on le remplace, sinon on l'ajoute dans Outlook.

- On ferme et libère les variables.

On teste si Outlook est déjà ouvert :

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook
End If

On crée les objets Application et NameSpace d'Outlook, la référence au compte de messagerie et à la base en cours, puis on ouvre le Recordset basé sur la requête contenant le rendez-vous actif :

' Création de l'objet Application d'Outlook
Set objApp = new Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("EMail", "T_CompteMessagerie"))

' Référence à la base de données courante
Set db = CurrentDb

' Ouverture du recordset contenant le rendez-vous affiché sur le formulaire
Set rs = db.OpenRecordset("select * from T_RendezVous where [IdRendezVous]=" & Nz(Forms!F_RendezVous![IdRendezVous], 0), dbOpenDynaset)
...

Pour chaque enregistrement, on recherche le rendez-vous Outlook ayant comme identifiant la valeur du champ IdRendezVousOutlook :

If Not rs.EOF Then ' On parcourt la liste des rendez-vous présents dans le recordset Access

IdRendezVousOutlook = Nz(rs!IdRendezVousOutlook, "") ' Identifiant du rendez-vous Outlook

On Error Resume Next
' Référence au rendez-vous Outlook ayant comme EntryID l'id Outlook dans Access
Set objAppointment = objSpace.GetItemFromID(IdRendezVousOutlook, objCptFolder.StoreID)
On Error GoTo Err_MajRendezVous
...

Si le rendez-vous de l'enregistrement Access est présent dans Outlook, on le met à jour, sinon on l'ajoute dans la base Access :

If TypeName(objAppointment) = "Nothing" Then ' Si aucun rendez-vous n'a été trouvé
' On crée le rendez-vous Outlook
Set objAppointment = objApp.CreateItem(olAppointmentItem)
End If

' On met à jour le rendez-vous Outlook
UpdateRendezVousOutlook objAppointment, rs, objSpace

MajRendezVous = True
...

Pour finir, on minimise la fenêtre Outlook pour revenir à la fenêtre Access, puis ferme et libère les variables :

'On minimise la fenêtre Outlook pour revenir sur Access
objApp.ActiveWindow.WindowState = 1

Err_MajRendezVous:
If (Err.Number <> 0) And Not MajRendezVous Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
If Not (rs Is Nothing) Then
rs.Close
End If
Set rs = Nothing
Set db = Nothing
Set objAppointment = Nothing
Set objAppointment2 = Nothing
Set objFolder = Nothing
Set objCptFolder = Nothing
Set objSpace = Nothing
Set objApp = Nothing

VII-M - Fonction SupprimerRendezVousOutlook

Déroulé de la fonction

- On teste si Outlook est ouvert et on l'ouvre si ce n'est pas le cas.

- On crée les objets Application et NameSpace d'Outlook.

- On recherche le rendez-vous Outlook ayant comme identifiant la chaîne de caractères passée en argument.

- Si on le trouve, on le supprime dans Outlook.

- On ferme et libère les variables.

On teste si Outlook est déjà ouvert :

If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
RunOutlook
End If

On crée les objets Application et NameSpace d'Outlook, puis la référence au compte de messagerie :

' Création de l'objet Application d'Outlook
Set objApp = new Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("EMail", "T_CompteMessagerie"))
...

On recherche le rendez-vous Outlook ayant comme identifiant la valeur du champ IdRendezVousOutlook :

On Error Resume Next
Set objAppointment = objSpace.GetItemFromID(IdRendezVousOutlook) ' Référence au rendez-vous Outlook ayant comme EntryID l'id Outlook dans Access
On Error GoTo Err_SupprimerRendezVousOutlook
...

On teste si le rendez-vous est présent dans Outlook, si c'est le cas, on le supprime :

If TypeName(objAppointment) <> "Nothing" Then ' Si un rendez-vous a été trouvé
' On supprime le rendez-vous Outlook
objAppointment.Delete
SupprimerRendezVousOutlook = True
End If
...

Pour finir, on minimise la fenêtre Outlook pour revenir à la fenêtre Access, puis ferme et libère les variables :

'On minimise la fenêtre Outlook pour revenir sur Access
objApp.ActiveWindow.WindowState = 1

Err_SupprimerRendezVousOutlook:
If (Err.Number <> 0) and Not SupprimerRendezVousOutlook Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
Set objAppointment = Nothing
Set objSpace = Nothing
Set objApp = Nothing

VII-N - Fonction MajCalendriersOutlook

Déroulé de la fonction

- On crée l'objet Application d'Outlook.

- On vide la table T_CalendrierOutlook et ouvre le Recordset basé sur cette table.

- On parcourt les dossiers et sous-dossiers Outlook à la recherche des calendriers.

- On ajoute les noms de ces dossiers à la table.

- On ferme et libère les variables.

>On crée les objets Application et NameSpace d'Outlook, puis la référence au compte de messagerie :

' Création de l'objet Application d'Outlook
Set objApp = new Outlook.Application

' Création de l'objet NameSpace d'Outlook
Set objSpace = objApp.GetNamespace("MAPI")

' Référence au dossier principal du compte de messagerie
Set objCptFolder = objSpace.Folders(DLookup("email", "T_CompteMessagerie"))

On vide la table T_RendezVousOutlook et ouvre le Recordset basé sur cette table :

' Référence à la base courante
Set db = CurrentDb

' Suppression des Calendriers Outlook dans la table T_CalendrierOutlook
db.Execute "delete * from T_CalendrierOutlook;", dbFailOnError

' Ouverture du recordset basé sur la table T_DossierOutlook
Set rs = db.OpenRecordset("T_DossierOutlook", dbOpenDynaset)

On parcourt les dossiers et sous-dossiers Outlook à la recherche de calendriers, puis, une fois trouvé, on ajoute dans la table l'identifiant, le nom du dossier Outlook et celui de son dossier parent :

' Dans le dossier principal du compte de messagerie
With objCptFolder

' On parcourt les dossiers contenus dans ce dossier parent
For Each objFolder In .Folders

If objFolder.DefaultItemType = olAppointmentItem Then ' Si c'est un Calendrier de rendez-vous

rs.AddNew ' Ajout de l'identifiant, du nom du Calendrier Outlook et de son Calendrier parent
rs!IdCalendrier = objFolder.EntryID
rs!NomCalendrier = objFolder.Name
rs.Update

End If

' On parcourt les sous-dossiers Outlook
For Each objSubFolder In objFolder.Folders
If objSubFolder.DefaultItemType = olAppointmentItem Then ' Si c'est un Calendrier de rendez-vous
rs.AddNew ' Ajout de l'identifiant, du nom du Calendrier Outlook et de son Calendrier parent
rs!IdCalendrier = objSubFolder.EntryID
rs!NomCalendrier = objSubFolder.Name
rs.Update
End If
Next

Next

Next i
...

Pour finir, on ferme et libère les variables :

Err_MajCalendriersOutlook:
If Err.Number <> 0 Then ' Partie gestion de l'erreur
MsgBox "MS Access a généré une erreur" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Note de l'erreur: " & _
Err.Note, vbCritical, "Une erreur a eu lieu !"
End If
On Error Resume Next
'Fermeture et libération des variables
If Not (rs Is Nothing) Then
rs.Close
End If
Set rs = Nothing
Set db = Nothing
Set objSubFolder = Nothing
Set objFolder = Nothing
Set objCptFolder = Nothing
Set objSpace = Nothing
Set objApp = Nothing

VIII - Les bases de données à télécharger

Les bases jointes sont au format accdb.

L'application comporte également un module pour gérer les rendez-vous périodiques. Enregistrez bien au début l'adresse e-mail de votre compte de messagerie dans la table T_CompteMessagerie.

IX - Remerciements

Je tiens à remercier Laurent Ott pour m'avoir conseillé pour la réalisation de cet article, ainsi que f-leb pour sa relecture.