Mise à jour des rendez-vous entre Access et Outlook

Objectif : Décrire les procédures de mise à jour des rendez-vous entre Access et Outlook depuis un formulaire Access.

Niveau requis : avancé.

Commentez cet article : Commentez Donner une note à l'article (0)

Article lu   fois.

L'auteur

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Introduction

On se propose de mettre à jour les informations de nos rendez-vous entre Access et Outlook depuis un formulaire Access :

Procédures de mise à jour

  • Importations des rendez-vous Outlook dans Access.
  • Exportations des rendez-vous Access dans Outlook.
  • Suppression d'un rendez-vous dans Access ou Outlook.
Formulaire F_ListeRendezVous
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.02 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 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

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 :

 
Sélectionnez
Set objAppointment = objApp.CreateItem(olAppointmentItem)

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

 
Sélectionnez
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.

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
Mise à jour du rendez-vous
Ajout du rendez-vous
Ajout du rendez-vous

IV-B. Opérations d'exportation

On vérifie si le rendez-vous 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
Mise à jour du rendez-vous
Ajout 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 des deux côtés
Suppression dans Access
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
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
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
Sélectionnez
Private Sub CmdImportRendezVous_Click()
' Exécute l'importation des rendez-vous Outlook
On Error GoTo End_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) = 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 ' On actualise les listes de choix et le sous-formulaire
      
      MsgBox ("L'importation des rendez-vous a été réalisée avec succès !") ' Affichage du message de succès
   End If
   
End_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.Note, 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 Access compris dans une période, en remplaçant ceux ayant le même identifiant.

Bouton cmdExportRendezVous
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
Sélectionnez
Private Sub CmdExportRendezVous_Click()
' Exécute l'exportation des rendez-vous dans Outlook
On Error GoTo End_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) = vbNo Then
      Exit Sub
   End If

   If ExportRendezVous Then ' On exporte les rendez-vous dans Outlook
      '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
   
End_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.Note, 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
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
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.
 
Sélectionnez
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.Column(2) & "'"
   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
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
Sélectionnez
Private Sub CmdActualiser_Click()
' Procédure d'actualisation du formulaire et de ses listes
On Error GoTo end_CmdActualiser_Click
  
   ' Si l'utilisateur ne souhaite pas actualiser le contact, on sort
   If MsgBox("Souhaitez-vous actualiser le formulaire Access ?", vbYesNo) = vbNo Then
      Exit Sub
   End If
  
   If Not IsOutLookRunning() Then ' Si Outlook n'est pas déjà ouvert
      RunOutlook ' On lance Outlook
   End If

MajCalendriersOutlook ' On met à jour la liste des calendriers Outlook

Me.Refresh ' On actualise le formulaire

' Partie gestion de l'erreur
end_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
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
Sélectionnez
Private Sub CmdInitialiserLiens_Click()
' Exécute de la procédure d'initialisation des liens en cas de changement d'ordinateur
   
   ' Si l'utilisateur souhaite initialiser les liens entre Access et Outlook
   If MsgBox("Souhaitez-vous initialiser les liens ?", vbYesNo) = 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
   
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
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 de valider les changements effectués sur le rendez-vous dans le formulaire F_RendezVous, puis d'exporter ce rendez-vous dans Outlook.

Bouton cmdValiderRendezVous
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
Sélectionnez
Private Sub CmdValiderRendezVous_Click()
' Exécute l'enregistrement du rendezVous côté Access et Outlook
On Error GoTo End_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) = 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
   
End_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
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
Sélectionnez
Private Sub CmdSupprimerRendezVous_Click()
' Procédure de suppression du rendez-vous affiché
On Error GoTo End_CmdSupprimerRendezVous_Click
   
   If MsgBox("Souhaitez-vous supprimer ce rendez-vous ?", vbYesNo) = 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

End_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.Note, 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 cmbDossierOutlook
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 EstFerieEstFerie prise dans la FAQ Access, avec notamment le calcul du lundi de Pâques suivant la méthode de Thomas O'Beirne.

 
Sélectionnez
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é ».

 
Sélectionnez
Public 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 :

 
Sélectionnez
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 ' On libère la variable

End Function

VII-D. Procédure RunOutlook

Procédure de lancement d'Outlook.

 
Sélectionnez
Public Sub RunOutlook()
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.

 
Sélectionnez
Public Function Evaluer(fieldvalue As Variant) As Variant
Dim s As String
   
   s = Nz(fieldvalue, "") ' Si la valeur est nulle on passe une chaîne vide
   
   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 contenant le rendez-vous Access, l'objet AppointmentItem du rendez-vous Outlook, et son dossier.

Procédure AddRendezVousOutlook
CacherSélectionnez

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

Elle permet de mettre à jour le rendez-vous Access avec les données du rendez-vous Outlook. Elle prend en argument le Recordset contenant le rendez-vous Access, l'objet AppointmentItem du rendez-vous Outlook, et son dossier.

Procédure UpdateRendezVousAccess
CacherSélectionnez

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

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

Procédure UpdateRendezVousOutlook
CacherSélectionnez

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 :

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

On crée l'objet Application d'Outlook, la référence à la base en cours et on ouvre le Recordset basé sur la table T_RendezVous :

 
Sélectionnez
' Création de l'objet Application d'Outlook
Set objApp = New Outlook.Application
   
' Référence à la base de données courante
Set db = CurrentDb

' Ouverture du recordset basé sur la table T_Appointment contenant les Appointments 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 :

 
Sélectionnez
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.Column(2)
   
    ' On parcourt les dossiers parents d'Outlook
   For i = 1 To objApp.ActiveExplorer.Session.Folders.Count
      
       ' On parcourt les dossiers contenus dans ces dossiers parents
      For Each objFolder In objApp.ActiveExplorer.Session.Folders.Item(i).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 = "*") 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 :

 
CacherSélectionnez

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

 
CacherSélectionnez

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 :

 
Sélectionnez
   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 à la base en cours et on ouvre le Recordset en fonction des choix effectués sur le formulaire :

 
Sélectionnez
' 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 à 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.Column(2) & "'"
   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 :

 
CacherSélectionnez

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 :

 
CacherSélectionnez

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

 
CacherSélectionnez

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 :

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

On crée l'objet Application d'Outlook, la référence à la base en cours et on ouvre le Recordset basé sur la table T_RendezVous :

 
Sélectionnez
'' Création de l'objet Application d'Outlook
Set objApp = new Outlook.Application
   
' 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 :

 
CacherSélectionnez

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 :

 
CacherSélectionnez

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

 
CacherSélectionnez

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 :

 
Sélectionnez
   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 à la base en cours et on ouvre le Recordset basé sur la table T_RendezVous :

 
Sélectionnez
' 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 à 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 :

 
CacherSélectionnez

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 :

 
CacherSélectionnez

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

 
CacherSélectionnez

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 :

 
Sélectionnez
   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 :

 
Sélectionnez
' 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")
...

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

 
CacherSélectionnez

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

 
CacherSélectionnez

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

 
CacherSélectionnez

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 l'objet Application d'Outlook :

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

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

 
Sélectionnez
' Suppression des dossiers Outlook dans la table T_DossierOutlook
DoCmd.SetWarnings False
DoCmd.RunSQL ("delete * from T_DossierOutlook;")
DoCmd.SetWarnings True

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

' 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 :

 
CacherSélectionnez

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

 
CacherSélectionnez

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

Les bases jointesgestion-rendezvous sont au format mdb et accdb.

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.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

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. Droits de diffusion permanents accordés à Developpez LLC.