Discussion :

[LeMin]

Bonjour à tous,

Initialement, je voulais écrire via Access un rendez vous dans outlook / agenda. Ayant déjà utilisé Access pour rédiger des mails et les transférer à outlook/mail, je pense que de la même manière, je peux le faire dans l'agenda d'outlook.

Mais mon client utilise calendrier associé à un compte outlook.com. Il le partage sur plusieurs PC connectés au même compte.

D'où ma question: savez vous s'il est possible via Access (VBA) d'écrire un rendre vous dans cet agenda "calendrier" partagé ?

Merci pour vos retours éclairés

[User]

Bonjour,

Il faut commencer par cocher la référence à "Microsoft Outlook 1X.0 object library" pour avoir accès aux objets du modèle Outlook.

Ensuite, comme idée de code, vous pouvez suivre ce lien :

https://www.developpez.net/forums/d1...k/#post8015967

Un autre exemple sur un bouton de commande placé dans un formulaire contenant les zones de texte Objet, Emplacement, Categorie, DateDebut, HeuDebut, DateFin, HeureFin, Note, etc. :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Private Sub cmdAjouterRendezVous()
 
    ' Fonction d'exportation d'un rendez-vous dans Outlook
    Dim objApp As Outlook.Application
    Dim objSpace As Outlook.NameSpace
    Dim objCptFolder As Outlook.Folder
    Dim objAppointment As Outlook.AppointmentItem
 
    ' 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("dupont@gmail.com")
 
    ' On crée le rendez-vous Outlook
    Set objAppointment = objApp.CreateItem(olAppointmentItem)
 
    ' On met à jour le rendez-vous Outlook
    With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous
 
        .Subject = Me!Objet
 
        .Location = Me!Emplacement
 
        .Categories = Me!Categorie
 
        .Start = CDate(Me!DateDebut) + CDate(Me!HeureDebut)
        .End = CDate(Me!DateFin) + CDate(Me!HeureFin)
 
        .Body = Me!Note
 
        .Save ' Sauvegarde des modifications dans le rendez-vous Outlook
 
        Set objFolder = objSpace.GetDefaultFolder(olFolderCalendar) 
 
        If objFolder.Name <> .Parent.Name Then
            Set objAppointment2 = .Move(objFolder) ' Déplacement du rendez-vous dans le bon Calendrier
        End If
 
    end with
 
    'Fermeture et libérations des variables
    Set objAppointment = Nothing
    Set objAppointment2 = Nothing
    Set objFolder = Nothing
    Set objCptFolder = Nothing
 
end sub

Après c'est à vous d'adapter tout ça, les situations sont toutes différentes et nécessitent bien souvent des adaptations (ex. : prise en compte d'une récurrence pour les rendez-vous ).

Donc, si besoin il faudra faire une recherche supplémentaire avec ces éléments que je vous donne

Cdlt,

[LeMin]

Merci User pour ton code très intéressant.
Je l'ai mis en place: j'ai juste modifié objFolder par objCptFolder à la fin car il me sortait une erreur (objFolder inconnu)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Private Sub RVous_Click()
    ' Fonction d'exportation d'un rendez-vous dans Outlook
    Dim objApp As Outlook.Application
    Dim objSpace As Outlook.NameSpace
    Dim objCptFolder As Outlook.Folder
    Dim objAppointment As Outlook.AppointmentItem
    Dim objAppointment2 As Outlook.AppointmentItem 'jlb
 
Dim Sujet, Location, Categorie, Note As String
Dim DateDebut, DateFin As Date
Dim HeureDebut, HeureFin As Date
Sujet = "Test RV ajouté par Access"
Location = "Garage"
Categorie = ""
DateDebut = "25/09/23"
HeureDebut = "14:00"
DateFin = "25/09/23"
HeureFin = "16:00"
Note = "Test note"
 
    ' 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("lemin30@live.fr")
 
    ' On crée le rendez-vous Outlook
    Set objAppointment = objApp.CreateItem(olAppointmentItem)
    Set objAppointment2 = objApp.CreateItem(olAppointmentItem)
 
    ' On met à jour le rendez-vous Outlook
    With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous
 
        .Subject = Sujet
 
        .Location = Location
 
        .Categories = Categorie
 
        .Start = CDate(DateDebut) + CDate(HeureDebut)
        .End = CDate(DateFin) + CDate(HeureFin)
 
        .Body = Note
 
        .Save ' Sauvegarde des modifications dans le rendez-vous Outlook
 
        Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar) 'jlb
 
        If objCptFolder.Name <> .Parent.Name Then
            Set objAppointment2 = .Move(objCptFolder) ' Déplacement du rendez-vous dans le bon Calendrier jlb
        End If
 
    End With
 
    'Fermeture et libérations des variables
    Set objAppointment = Nothing
    Set objAppointment2 = Nothing
    'Set objFolder = Nothing jlb
    Set objCptFolder = Nothing
End Sub

En le lançant et en mettant en commentaire la ligne 28

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.Folders("lemin30@live.fr")

Il crée bien un RVous dans mon agenda local Outlook

En activant la ligne 28, j'avais une erreur. J'ai donc ajouté le compte "lemin30@live.fr" à ma configuration outlook.
Je n'ai maintenant plus d'erreur à l'éxécution, mais le RVous est crée dans mon agenda local et pas dans l'agenda lié à "lemin30@live.fr"

as tu une idée ?

[User]

Salut,

Vraiment compliqué..

Ce que je comprends c'est qu'il prend le calendrier par défaut avec cette commande :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar) 'jlb

D'où mon idée d'essayer de désactiver cette commande :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

' Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar) 'jlb

Pour la remplacer par une autre...

Il faudrait donc d'abord essayer de rechercher le calendrier dans les sous dossiers de "lemin30@live.fr" avec cette fonction à copier dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
function getCalendar(objCptFolder) as Outlook.Folder
 
  ' 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
	        set getCalendar = objFolder
                exit function
            end if
 
        next
 
    end with
 
end function

Faudra peut-être explorer les sous-sous-dossiers...

Puis à utiliser comme cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Private Sub RVous_Click()
    ' Fonction d'exportation d'un rendez-vous dans Outlook
    Dim objApp As Outlook.Application
    Dim objSpace As Outlook.NameSpace
    Dim objCptFolder As Outlook.Folder
    Dim objFolder As Outlook.Folder ' ligne ajoutée
    Dim objAppointment As Outlook.AppointmentItem
    Dim objAppointment2 As Outlook.AppointmentItem 'jlb
 
    Dim Sujet, Location, Categorie, Note As String
    Dim DateDebut, DateFin As Date
    Dim HeureDebut, HeureFin As Date
 
    Sujet = "Test RV ajouté par Access"
    Location = "Garage"
    Categorie = ""
    DateDebut = "25/09/23"
    HeureDebut = "14:00"
    DateFin = "25/09/23"
    HeureFin = "16:00"
    Note = "Test note"
 
    ' 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("lemin30@live.fr")
 
    ' On crée le rendez-vous Outlook
    Set objAppointment = objApp.CreateItem(olAppointmentItem)
 
    With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous
 
        .Subject = Sujet
 
        .Location = Location
 
        .Categories = Categorie
 
        .Start = CDate(DateDebut) + CDate(HeureDebut)
        .End = CDate(DateFin) + CDate(HeureFin)
 
        .Body = Note
 
        .Save ' Sauvegarde des modifications dans le rendez-vous Outlook
 
        Set objFolder = getCalendar(objCptFolder) 'jlb: ligne modifiée : dossier objFolder avec utilisation de la fonction getCalendar copiée dans un module
 
        If objFolder.Name <> .Parent.Name Then
            Set objAppointment2 = .Move(objFolder) ' Déplacement du rendez-vous dans le bon Calendrier jlb
        End If
 
    End With
 
    'Fermeture et libérations des variables
    Set objAppointment = Nothing
    Set objAppointment2 = Nothing
    Set objFolder = Nothing 
    Set objCptFolder = Nothing
 
End Sub

Pas simple tout ça..

[LeMin]

J'ai une erreur d'exécution dans GetCalendar: variable non définie en ligne 7 sur objFolder

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function getCalendar(objCptFolder) As Outlook.Folder
 
  ' 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
            Set getCalendar = objFolder
                Exit Function
            End If
 
        Next
 
    End With
 
End Function

Si je remplace objFolder par objCptFolder, il me mets "incompatibilité de type"

Et une remarque par rapport à ma conf outlook: je ne vois pas le calendrier associé au compte "lemin30@live.fr". ou je ne sais pas faire comment le voir (outlook 2007)



Je le vois par l'application "calendrier" de microsoft (installé de base avec W10)

[User]

Je n'ai pas testé la fonction, mais simplement quand tu as une variable non définie. alors tu la déclares :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Function getCalendar(objCptFolder) As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
  ' 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
                Set getCalendar = objFolder
                Exit Function
            End If
 
        Next
 
    End With
 
End Function

[LeMin]

Ok, merci: c'est déclaré.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous
 
        .Subject = Sujet
 
        .Location = Location
 
        .Categories = Categorie
 
        .Start = CDate(DateDebut) + CDate(HeureDebut)
        .End = CDate(DateFin) + CDate(HeureFin)
 
        .Body = Note
 
        .Save ' Sauvegarde des modifications dans le rendez-vous Outlook
 
        Set objFolder = getCalendar(objCptFolder) 'jlb: ligne modifiée : dossier objFolder avec utilisation de la fonction getCalendar copiée dans un module
 
        If objFolder.Name <> .Parent.Name Then
            Set objAppointment2 = .Move(objFolder) ' Déplacement du rendez-vous dans le bon Calendrier jlb
        End If
 
    End With

Il s'arrête en L18 "If objFolder.Name <> .Parent.Name Then"
Variable objet ou variable de block With non définie

[User]

Il ne trouve pas de calendrier dans les sous-dossier de "lemin30@live.fr", la variable objFolder ne contient rien.

Modifie la fonction getCalendar comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
function getCalendar(objCptFolder) as Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim objSubFolder As Outlook.Folder
 
  ' Dans le dossier principal du compte de messagerie
    With objCptFolder
 
        ' On parcourt les dossiers contenus dans ce dossier parent
        For Each objFolder In .Folders
            debug.print(objFolder.Name)
            If objFolder.DefaultItemType = olAppointmentItem Then ' Si c'est un Calendrier de rendez-vous
	        set getCalendar = objFolder
                exit function
            end if
 
            ' On parcourt les sous-dossiers Outlook
            For Each objSubFolder In objFolder.Folders
                debug.print("-------" & objSubFolder.Name)
		If objSubFolder.DefaultItemType = olAppointmentItem Then ' Si c'est un Calendrier de rendez-vous
	            set getCalendar = objSubFolder
                    exit function
                end if
            next
 
        next
 
    end with
 
end function

Ensuite, va dans la fenêtre d'exécution de l'éditeur VBA, pour voir les noms des sous-dossiers qui s'affichent avec la commande debug.print(objFolder.Name).

Cdlt,

[LeMin]

Merci pour ta patience

Débug print:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Boîte de réception
@orange.fr - jl.bion
Archive
Deleted
Drafts
Junk
Notes
Outbox
Sent

Effectivement, le calendrier n'y est pas

Et je ne voit pas comment rajouter mon calendrier partagé associé à "lemin30@live.fr" dans outlook 2007

[User]

Dans quel dossier se trouve ton agenda local ?

Essaie de changer au début :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.Folders("lemin30@live.fr")

Par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar)
 
debug.print (objCptFolder.Parent.name)

la ligne debug.print (objCptFolder.Parent.name) va afficher le nom du dossier parent qui le contient.

Peut-être essayer par la suite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar).Parent

Pour pointer directement sur le dossier parent et pouvoir ainsi lister les sous-éléments de ce dossier avec getCalendar.

[LeMin]

En changeant au début par le calendrier par défaut, Access écrit bien le RVous dans le calendrier par défaut et le déplace ensuite dans le calendrier situé dans l'arborescence (calendrier Nominis).

Voici mon débug print

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
calendrier par défaut=Dossiers Personnels
Calendrier Nominis
Calendrier trouvé!

voici le code actuel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Private Sub RVous_Click()
    ' Fonction d'exportation d'un rendez-vous dans Outlook
    Dim objApp As Outlook.Application
    Dim objSpace As Outlook.NameSpace
    Dim objCptFolder As Outlook.Folder
    Dim objFolder As Outlook.Folder ' ligne ajoutée
    Dim objAppointment As Outlook.AppointmentItem
    Dim objAppointment2 As Outlook.AppointmentItem 'jlb
 
    Dim Sujet, Location, Categorie, Note As String
    Dim DateDebut, DateFin As Date
    Dim HeureDebut, HeureFin As Date
 
    Sujet = "Test RV ajouté par Access"
    Location = "Garage"
    Categorie = ""
    DateDebut = "25/09/23"
    HeureDebut = "14:00"
    DateFin = "25/09/23"
    HeureFin = "16:00"
    Note = "Test note"
 
    ' 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("lemin30@live.fr")
    Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar)
    Debug.Print ("calendrier par défaut=" & objCptFolder.Parent.Name)
 
    ' On crée le rendez-vous Outlook
    Set objAppointment = objApp.CreateItem(olAppointmentItem)
 
    With objAppointment  ' Mise à jour des champs Outlook avec les données Access du rendez-vous
 
        .Subject = Sujet
 
        .Location = Location
 
        .Categories = Categorie
 
        .Start = CDate(DateDebut) + CDate(HeureDebut)
        .End = CDate(DateFin) + CDate(HeureFin)
 
        .Body = Note
 
        .Save ' Sauvegarde des modifications dans le rendez-vous Outlook
 
        Set objFolder = getCalendar(objCptFolder) 'ligne modifiée : dossier objFolder avec utilisation de la fonction getCalendar copiée dans un module
 
        If objFolder.Name <> .Parent.Name Then
            Set objAppointment2 = .Move(objFolder) ' Déplacement du rendez-vous dans le bon Calendrier
        End If
 
    End With
 
    'Fermeture et libérations des variables
    Set objAppointment = Nothing
    Set objAppointment2 = Nothing
    Set objFolder = Nothing
    Set objCptFolder = Nothing
 
End Sub

Voici ma liste des dossiers outlook

J'aimerais ajouter le calendrier attaché à mon compte "lemin30@live.fr" dans la liste en dessous de 'calendrier', mais je ne sais pas comment faire...

si, au début je mets

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar).Parent

au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set objCptFolder = objSpace.GetDefaultFolder(olFolderCalendar)

, debug print devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
calendrier par défaut=Dossiers Personnels
Calendrier Nominis
Calendrier trouvé!
Eléments supprimés
-------Margot
-------CarnetIfsi2013-2014-1ere années
-------ContactPartagé
-------ContactPublic
-------Groupe
------- Calendrier trouvé!
Eléments supprimés
-------Margot
-------CarnetIfsi2013-2014-1ere années
-------ContactPartagé
-------ContactPublic
-------Groupe
------- Calendrier trouvé!

et je ne trouve pas ou il écrit

[User]

J'ai trouvé ça concernant les dossiers partagés :

https://learn.microsoft.com/fr-fr/of...ddefaultfolder

Essayer quelque chose comme ça pour le folder partagé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set myRecipient = objSpace.CreateRecipient("Dan Wilson") 
Set objFolder = objSpace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)

Mais pour être honnête j'ignore comment créer cet objet recipient :

https://learn.microsoft.com/fr-fr/of...look.recipient

[LeMin]

Merci encore pour tes idées.

J'ai regardé de plus près outlook. D'après la littérature, on peut synchroniser un agenda avec une adresse en outlook.com.
J'ai donc crée un compte( plutôt que d'utiliser mon adresse en live.fr)
Il faut ensuite l'intégrer dans outlook ni en POP, ni en IMAP, mais en Exchange.
Mon outlook 2007 était trop ancien (des erreurs ..)
J'ai donc installé office 2019.
Puis configuré outlook 2019 pour l'accrocher à mon adresse en outlook.com
L'agenda synchronisé est apparu sans autre effort.

Et ta petite routine VBA a bien écrit dans cet agenda partagé (que je peux aussi consulter avec l'application "calendrier" de microsoft).

Tout est bien qui fini bien. Je marque en Résolu
Bonne fin de journée.