Macro pour enregistrer un RDV dans 2 calendriers différents [Résolu]

[bong03]

Bonjour,

Voilà, je débute en VBA pour Outlook (je me débrouille un peu le VBA pour Excel) et je désire créer une macro (affecter à un bouton) qui enregistre le rendez-vous en cours de saisie dans 2 calendriers différents, dont 1 est un calendrier situé dans le dossier public (j'utilise Exchange).

Ceci permattrais donc d'enregistrer en 1 seul clic le même RDV dans plusieurs calendrier en même temps.

Merci aux gentils contributeurs qui me fourniront des morceaux de codes (ou mieux le code complet ) que je pourrais utiliser.

Alf

[bong03]

Bonjour,

Bon, j'avance... à petits pas ! (comme je ne fais pas que ça... comme vous tous ).

Voici le bout de code que j'ai créé (en m'inspirant de ce qui existait ) :

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
 
Sub enregistrerRDVMulticalendrier()
 
 
    On Error GoTo AddAppt_Err
 
    Dim OutObj      As Outlook.Application
    Dim OutAppt1    As Outlook.AppointmentItem
    Dim OutAppt2    As Outlook.AppointmentItem
    Dim MyCalendar1 As Outlook.Items
    Dim MyCalendar2 As Outlook.Items
 
    Set OutObj = CreateObject("Outlook.Application")
 
 
    Set MyCalendar1 = OutObj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
    Set MyCalendar2 = OutObj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders.Item("Calendrier TRAVAIL").Items
 
    Set OutAppt1 = MyCalendar1.Add(olAppointmentItem)
    Set OutAppt2 = MyCalendar2.Add(olAppointmentItem)
 
 
    OutAppt1.Save
    OutAppt2.Save
 
    Set OutObj = Nothing  ' Retire de la mémoire les objets créer
 
    Exit Sub
 
AddAppt_Err:
         MsgBox "Error " & Err.Number & vbCrLf & Err.Description
         Exit Sub
 
End Sub

J'ai créé le bouton dans la fenêtre qui s'ouvre quand on fais créer un nouveau rendez-vous. Et je lui ai associé cette macro.

Après avoir renseigner tous les éléments du RDV (objet, heures...), lorsque je clique sur mon bouton-macro, le RDV est bien créé dans les 2 calendriers à l'heure voulue. Le souci c'est qu'il n'enregistre pas l'objet du message.

Avez-vous des idées ?

Alf

[Heureux-oli]

Regarde si avec OutAppt1, tu n'aurais pas un .Subject comme propriété.

[bong03]

Merci Heureux-oli de t'intéresser à mon problème.

En fait ma macro se lancerais quand on appuierrais sur le bouton correspondant dans le RDV en cours de saisie.

Le propriété .Subject existe pour OutAppt1 mais ça ne marche pas : il attend une valeur à mettre dedans (OutAppt1.Subject = "RDV"). En effet, je veux qu'il enregistre le RDV en cours de saisie dans 2 (ou 3) calendriers donc qu'il me cré automatiquement 2 RDV dans 2 (ou 3) calendriers avec dans le sujet, la localisation (Emplacement), heures, etc. ce que j'ai saisie...

Je sais plus trop comment expliquer...

En fait j'ai besoin de connaitre les objets en cours de saisies pour les affectés à mes objet RDV... si vous me suivez toujours...

Alf

[Heureux-oli]

Si l'un des deux rendez-vous possède un sujet, on peut les faire correspondre.

Code :

OutAppt1.subject = OutAppt2.Subject

Ou vice versa.
Le premier est le vide, et le second, celui avec une valeur.

[Oliv-]

Salut,
Pourquoi le créer 2 fois et non pas le copier ?

Ca doit donner un truc du genre, regarde l'aide VBE.

Code :

1
2
3
 
set OutAppt2 = OutAppt1.copy 
OutAppt2.move MyCalendar2

Il vaudrait mieux aussi utiliser
set OutAppt1 = OutObj.CreateItem(olAppointmentitem)
with OutAppt1
.subject ="test"
' et tous les autres propriétés de ton rdv
End with


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[bong03]

Salut !

Bon, je pense n'avoir pas été clair sur ce que j'aimerais

Voilà :
dans Outlook, je clique sur mon calendrier principal (j'ai un serveur Exchange).
Quand je fais nouveau, il m'ouvre une fenêtre pour saisir un nouveau RDV. Je saisi donc le l'objet, l'emplacement, les heures, le rappel...
Et lorsque je veux le sauvegarder, j'aimerais cliquer 1 seule fois sur un bouton derrrière lequel une macro enregistre ce RDV dans 2 (ou 3) calendriers.

Je peux faire des "Enregistrer sous..." plusieurs fois (autant que de calendriers) mais pour aller plus vite je voudrais le faire en 1 clic, les calendriers étant toujours les mêmes.

Avec le code ci-dessus, il me crée bien le RDV dans chaque calendrier, mais tout est vide : l'objet, l'emplacement, les heures... il n'y a que le rappel qui est OK pour le calendrier principal (ce que je veux, et je sais que le rappel ne fonctionne pas pour les autres calendriers).

Comment récuprér les informations en cours de saisie dans ma macro ?

(je me demande si je dois pas créer un formulaire spécifique, mais c'est pareil, il me faudra ma macro...). Je tourne en rond

Si qq à des idées...

Alf

[Oliv-]

Salut,
Effectivement t'étais pas sur la bonne voie,
pour récupérer le RDV que tu es en train de créer :

Code :

set myrdv= ActiveInspector.CurrentItem

Pour "enregistrez sous " dans un autre dossier c'est en fait un copier + déplacer

Tapes "copy" dans VBE puis tu le selectionnes et tu appuis sur F1 tu auras l'aide sur cette méthode regarde les exemples c'est assez proche de ce que tu veux faire. regarde aussi MOVE

ok ?
Oliv'

[bong03]

OK merci Oliv, je vais essayé cela demain.

Alf

[bong03]

Super, merci Oliv pour ton aide.

Voici le code (pour ceux que ça interresse) :

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
 
Sub CopyRDV()
 
    On Error GoTo AddAppt_Err
 
    Dim OutObj     As Outlook.Application
    Dim MyRDV      As Outlook.AppointmentItem
    Dim OutAppt    As Outlook.AppointmentItem
    Dim MyCalendarItem As Outlook.Items
    Dim MyCalendarFolder As Outlook.MAPIFolder
 
    Set OutObj = CreateObject("Outlook.Application")
    Set MyRDV = ActiveInspector.CurrentItem
 
    Set MyCalendarFolder = OutObj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Folders.Item("Calendrier TRAVAIL")
 
    MyRDV.Close olPromptForSave
 
    If MyRDV.Saved Then
        Set OutAppt = MyRDV.Copy
        With OutAppt
            .ReminderSet = False
            .Save
        End With
        OutAppt.Move MyCalendarFolder
    End If
 
    Set OutObj = Nothing  ' Retire de la mémoire les objets créer
 
    Exit Sub
 
AddAppt_Err:
         MsgBox "Error " & Err.Number & vbCrLf & Err.Description
         Exit Sub
End Sub

Le seul hic c'est que la partie "If MyRDV.Saved...End If" ne fonctionne pas.

Comment faire pour récupérer la réponse faite lors du "MyRDV.Close olPromptForSave" pour la gérer ?

(Si "oui" alors je copie et j'enregistre la copie dans le calendrier auxiliaire.)

Alf

[bong03]

Je retire ce que j'ai écris plus haut :
la partie "If MyRDV.Saved... End If" fonctionne.

Par contre si qq sait comment tirer parti de la réponse faite lors du "MyRDV.Close olPromptForSave" je prends ! Ca peut toujours servir !
(Après la réponse à cela je mettrais ce pb en résolu).

Merci encore.

Alf

[Oliv-]

Salut,
En fait tu fais une mauvaise utilisation de "saved" c'est une propriété pas un évenement, ca dit juste si le mail a été modifié depuis sa dernière sauvegarde.

Regarde l'aide sur l'événement, WRITE.

Oliv'

[bong03]

Bonjour,

Bon, voici le code que j'utilise :

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
67
68
69
70
71
72
73
74
75
76
 
Sub CopyRDV()
 
    On Error GoTo AddAppt_Err
 
    Dim EnrResult        As Integer
    Dim OutObj           As Outlook.Application
    Dim MyRDV            As Outlook.AppointmentItem
    Dim OutAppt          As Outlook.AppointmentItem
    Dim MyCalendarItem   As Outlook.Items
    Dim MyCalendarFolder As Outlook.MAPIFolder
    Dim RDVProperty As Outlook.UserProperty
 
    Randomize 'Initialise la fonction Rnd
 
    Set OutObj = CreateObject("Outlook.Application")
    Set MyRDV = ActiveInspector.CurrentItem
 
    'Répertoire du calendrier par défaut
    'Set MyCalendarFolder = OutObj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
 
    'Répertoire du calendrier commun
    'Set MyCalendarFolder = OutObj.GetNamespace("MAPI").GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders.Item("Calendrier des Commerciaux")
 
    Set MyCalendarFolder = OutObj.GetNamespace("MAPI").Folders.Item(3).Folders.Item("Calendrier TRAVAIL") '.GetDefaultFolder(olFolderCalendar).Folders.Item("Calendrier TRAVAIL")
 
    EnrResult = MsgBox("Voulez-vous enregistrer ce rendez-vous ?", vbYesNoCancel + vbQuestion)
    If EnrResult = vbYes Then
        If MyRDV.UserProperties.Find("IDORG") Is Nothing Then
            Set RDVProperty = MyRDV.UserProperties.Add("IDORG", olNumber, False, False)
            MyRDV.UserProperties.Find("IDORG").Value = Int((99999 * Rnd) + 1)
        Else
            Set RDVProperty = MyRDV.UserProperties.Find("IDORG")
        End If
 
        'If MyRDV.Saved Then
 
        MyRDV.Close olSave
        'MsgBox MyRDV.EntryID
        MyRDV.Save
        If MyRDV.Subject <> "" Then
            Set OutAppt = MyRDV.Copy
            With OutAppt
                .ReminderSet = False
                .Save
            End With
            OutAppt.Move MyCalendarFolder
            'MsgBox MyRDV.EntryID & vbNewLine & "totootot" & vbNewLine & OutAppt.EntryID & vbNewLine & MyRDV.UserProperties.Find("IDORG").Value & vbNewLine & "totootot" & vbNewLine & OutAppt.UserProperties.Find("IDORG").Value
        End If
    End If
    If EnrResult = vbNo Then
        MyRDV.Close olDiscard
    End If
 
    Set OutObj = Nothing  ' Retire de la mémoire les objets créer
    Set MyRDV = Nothing
    Set OutAppt = Nothing
    Set MyCalendarItem = Nothing
    Set MyCalendarFolder = Nothing
 
    Exit Sub
 
 
AddAppt_Err:
 
        MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
 
        Set OutObj = Nothing  ' Retire de la mémoire les objets créer
        Set MyRDV = Nothing
        Set OutAppt = Nothing
        Set MyCalendarItem = Nothing
        Set MyCalendarFolder = Nothing
 
        Exit Sub
 
End Sub

Je n'ai pas encore fais la partie concernant la modif ou la suppression d'un RDV du calendrier (jai juste commencer une ébauche avec "UserProperties.Add("IDORG", olNumber, False, False)")

En fait je cherche surtout à partager le second calendrier (celui créer) avec d'autre utilisateurs. Mais cela est dans un autre poste.

Je mais donc celui-ci en résolu.

Merci à tous.

Alf