Discussion :

[laurent.mario]

Bonjour,

je recherche les valeurs pour rajouter un rdv dans le dossier public et pas le dossier de base de l'utilisateur avec possibilité d'envoyer le rdv a plusieurs utilisateurs.

merci

[laurent.mario]

j'ai trouvé le code suivant, mais je n'arrive pas a ecrire dans le dossier publics.

merci pour vos pistes

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
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 MyFolder As Outlook.Items
 
Set objOutlook = CreateObject("Outlook.Application")
Set olns = objOutlook.GetNamespace("MAPI")
Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)
'Selectionne le calendrier
'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