RDV sur Calendrier Partagé Exchange - Erreur L'administrateur du serveur a restreint le nombre d'éléments

Version imprimable

Bonjour à tous,

Je développe actuellement une application de gestion de RDV sur Excel.

L'application permet notamment à l'utilisateur de créer un nouveau RDV sur le calendrier partagé des commerciaux de l'entreprise.

Au bout d'un certain nombre de RDV, mon code plante sur la ligne suivante :

Code:

Set objRDV = MyCalendar.Items.Add

Avec le message d'erreur suivant :

Citation:

Impossible d'ouvrir les informations de disponibilité.L'administrateur du serveur a restreint le nombre d'éléments pouvant être ouverts simultanément.Fermez les messages que vous avez ouverts ou supprimez des pièces jointes et des images de messages non envoyé que vous êtes en train de composer.

Mon administrateur réseau m'a confirmé que l'utilisateur de l'application avait "32 éléments ouverts"... Je ne sais pas s'il s'agit de sessions Outlook ou d'éléments...
En tout, ce n'est pas visible depuis son poste : une seule instance Outlook et pas de mail, ou RDV ouverts.

Je ne sais pas comment "fermer" ces éléments ou sessions Outlook... Pourriez-vous svp m'aider ? :)

Merci d'avance,

Voici le code utilisé :
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 Set objOutlook = CreateObject("Outlook.Application") Set myNamespace = objOutlook.GetNamespace("MAPI") Set objRDV = objOutlook.CreateItem(olAppointmentItem) Set myRecipient = myNamespace.CreateRecipient([mail du commercial]) myRecipient.Resolve If myRecipient.Resolved Then Set MyCalendar = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar) Set objRDV = MyCalendar.Items.Add With objRDV .Subject = [Sujet] .Start = [Date & Heure début] .Location = [Lieu] .Duration = [Durée] .Body = [Message] .Attachments.Add [PJ] .Display End With ObjOutlook.Quit Set objRDV= Nothing Set objOutlook = Nothing End If

10/07/2017, 11h24
casus_orez

Personne n'a une idée ?

Bonjour,
Essaye en mettant cela avec d'initier ta boucle

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim objOutlook 
Dim myNamespace 
 
Sub traitement ()
Set objOutlook = CreateObject("Outlook.Application")
Set myNamespace = objOutlook.GetNamespace("MAPI")
for i = 1 to 10
Createrdv
Next i
 
Set myNamespace = nothing
      Set objOutlook = Nothing
End sub

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
 
sub createrdv()
Set objRDV = objOutlook.CreateItem(olAppointmentItem)
Set myRecipient = myNamespace.CreateRecipient([mail du commercial])
 
myRecipient.Resolve
 
If myRecipient.Resolved Then
      Set MyCalendar = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)                                
      Set objRDV = MyCalendar.Items.Add
 
      With objRDV
            .Subject = [Sujet]
            .Start = [Date & Heure début]
            .Location = [Lieu]
            .Duration = [Durée]
            .Body = [Message]
            .Attachments.Add [PJ]                                        
            .Display  ' AS TU BESOIN d'AFFICHER LE RDV ?
      End With
 
      Set objRDV= Nothing
Set MyCalendar = nothing
 
End If
 
end sub