Création rendez-vous dans Outlook 2007 en VBA
Bonjour, je viens vers vous car mes recherches infructueuses et mes connaissances en VBA limitées ne m'ont pas permis de résoudre par moi-même le problème que je vais vous soumettre :
J'utilise la fonction mise au point par Macno pour ajouter un rendez-vous à un calendrier outlook. (ma config : vista pro + outlook et access 2007).
lien de la source : http://access.developpez.com/sources...endrierOutlook.
Lorsque je ne spécifie pas de calendrier particulier, donc quand la chaine PCalendrier est vide, la fonction ajoute sans problème le rendez-vous dans le calendrier par défaut à savoir "Calendrier".
Là où ça ne veut plus fonctionner, c'est quand je spécifie un calendrier différent : dans mon cas, j'ai créé un calendrier nommé "essai" au même niveau de l'arborescence que le calendrier par défaut (pas en sous-calendrier).
Je reçois systématiquement une erreur :
Error -2147221233
Impossible d'exécuter l'opération. Impossible de trouver un objet.
Voici le code tel que je l'ai modifié : j'ai simplement créer une variable supplémentaire (MyEssaiFld) pour faire des tests et visualiser le contenu de MyCalendarFolder et MyEssaiFld avec des MsgBox.
Code:
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
| Public Function CreerRendezVous(PCalendrier As String, _
PDate As String, _
PHeure As String, _
PDuree As Integer, _
PSubject As String, _
PNotes As String, _
PLieu As String, _
Optional PMinutesRappel As Integer = 0)
On Error GoTo Add_Err
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.NameSpace
Dim MycalendarFolder As Outlook.MAPIFolder
Dim MyEssaiFld As Outlook.MAPIFolder
Dim MyFolder As Outlook.Items
Set objOutlook = CreateObject("Outlook.Application")
Set olns = objOutlook.GetNamespace("MAPI")
Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)
MsgBox MycalendarFolder
Set MyEssaiFld = olns.Folders(PCalendrier)
MsgBox MyEssaiFld
'Selectionne le calendrier
If PCalendrier = "" Then
Set MyFolder = MycalendarFolder.Items
Else
Set MyFolder = MycalendarFolder.Folders(PCalendrier).Items
End If
Set objAppt = MyFolder.Add
'Cree le rendez vous
With objAppt
If PDuree > 0 Then
.Start = PDate & " " & PHeure
.Duration = PDuree
Else
.Start = PDate
.AllDayEvent = True
End If
.Subject = PSubject
.Body = PNotes
.Location = PLieu
'Ajoute le rappel
If PMinutesRappel > 0 Then
.ReminderMinutesBeforeStart = PMinutesRappel
.ReminderSet = True
End If
'Sauvegarde et ferme
.Save
.Close (olSave)
End With
'Libération des variables.
Set objAppt = Nothing
Set objOutlook = Nothing
MsgBox "Rdv ajouté!"
Exit Function
'Gere les erreurs
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Function |
Merci d'avance pour votre réponse. Chris.
PS : je pense que le problème viens de l'utilisation des chemins d'accès avec olns.Folders(PCalendrier) etc.. mais malgré les essais et les infos glanées sur l'utilisation de ces chemins, je n'arrive pas à me dépatouiller.
Voilà aussi les infos que j'ai pu glaner deci-delà:
http://excel.developpez.com/faq/?pag...AjouterContact
http://support.microsoft.com/kb/469686/fr
http://support.microsoft.com/kb/468547/fr
http://support.microsoft.com/kb/310244/fr
