Discussion :

[Nouvel arriviste]

Bonjour le forum,

J'ai un programme Excel qui me permet de comparer l'emploi du temps de 2 personnes, puis lorsqu'un créneau est disponible, il envoi une demande de réunion. Il y a tout un tableau de rdv et cela s’exécute pour toutes les lignes.

Mon soucis, c'est qu'il y a 2 adresses mail de connectées, et je souhaite que la réunion soit créé avec le deuxième compte. C'est important parce que ce compte est utilisé pour la prise de rdv et ne pas polluer l'emploi du temps du compte principal. Ce 2ème compte peut être utilisé par plusieurs personnes.

J'ai essayé de plusieurs façons et plusieurs code en fouillant sur le web et le 2 techniques principales que j'ai trouvé sont :
- passer par la partie calendrier. Cad choisir le bon calendrier dessus puis ajouter la réunion.
- choisir le bon compte puis ajouter une réunion.

Dans les 2 cas je retombe toujours sur le compte principal (j'ai inversé les adresses mails et j'ai mis l'adresse pour la création de rdv en adresse principal et l'adresse de la personne, la mienne pour le coup, en second et j'ai encore créé sur l'adresse principal). Je suis sûr que c'est possible car manuellement je peux créer une réunion sur le bon calendrier mais je ne parviens pas à le coder. C'est pour quoi après avoir pas mal cherché, je me tourne vers vous le forum =).

Je vous met les codes que j'ai essayé avec quelques commentaires.

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
Sub SendEmailFromSharedMailbox()
Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
 
Dim olNS As Outlook.Namespace
  Dim objOwner As Outlook.Recipient
 
  Set olNS = olApp.GetNamespace("MAPI")
  Set objOwner = olNS.CreateRecipient("creation.rdv@outlook.com")
    objOwner.Resolve
 
 If objOwner.Resolved Then
   'MsgBox objOwner.Name
 Set newCalFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
 
'Now create the email
 Set olAppt = newCalFolder.Items.Add(olAppointmentItem)
     With olAppt
     'Define calendar item properties
        .Start = "07/11/2020 2:00 PM"
        .End = "07/11/2020 2:30 PM"
        .Subject = "Appointment Subject Here"
        .Recipients.Add ("personne.un@outlook.com")
        '.SendUsingAccount = "creation.rdv@outlook.com"   J'ai essayé en rajoutant cette ligne mais ça ne change rien pour la création de réunion. En revanche ça fonctionne quand il s'agit de mail ...
        'Add more variables as required, eg reminder, importance, etc
        .Display
    End With
 End If
 
End Sub

Le deuxième code que j'ai essayé

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
 
Sub AjoutDansCalendrier(xCalendrier, xTitre, xHeurDeb, xDuree, xLieu, xBody, mailFormateur, mailNouvelArrivant, xTrouve)
 
'On Error Resume Next
 
'=======================================================================================
 
' Création d'un RDV sur Agenda OUTLOOK
 
'=======================================================================================
 
Dim olApp As Outlook.Application
 
Dim objNS As Outlook.Namespace
 
Dim objExpCal As Outlook.Explorer
 
Dim objNavMod As Outlook.CalendarModule
 
Dim ObjNavCalPart As Outlook.NavigationFolders
 
Dim objNavFolder As Outlook.NavigationFolder
 
Dim FolderPartage As Outlook.Folder
 
Dim F
 
'Dim xTrouve As Boolean
 
Set olApp = CreateObject("outlook.application")
 
Set objNS = olApp.Session
 
Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
 
Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
 
 
'--------------------------------------------------------------------------------------
 
' Parcours la liste des familles de calendrier et les calendriers de chaque famille
 
'--------------------------------------------------------------------------------------
xCalendrier = "Calendrier"
xTrouve = False
 
xNbrFamCal = objNavMod.NavigationGroups.Count
 
For F = 1 To xNbrFamCal
 
    xNbrSousCal = objNavMod.NavigationGroups.Item(F).NavigationFolders.Count
 
    For G = 1 To xNbrSousCal
        If G = 1 And F = 1 Then
            GoTo calendrier_suivant
        End If
 
        xNomFamilleCal = objNavMod.NavigationGroups.Item(F).Name
        xNomCalendrier = objNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).DisplayName
 
        If xNomCalendrier = xCalendrier Then
 
            'On Error Resume Next
 
            Set ObjNavCalPart = objNavMod.NavigationGroups.Item(xNomFamilleCal).NavigationFolders
            Set objNavFolder = ObjNavCalPart(xCalendrier)
            Set MonSousDoss = ObjNavCalPart(G)
 
            'FoldName = MonSousDoss.Folder.Name & "-" & MonSousDoss.Folder.FullFolderPath
 
            If Err Then
 
                xTrouve = False
 
                MsgBox "Calendrier : " & xCalendrier & " non accéssible !!!", vbCritical, "ERREUR"
 
            Else
 
                xTrouve = True
                xMess = Empty
 
            End If
 
        Exit For
 
        Else
            xTrouve = False
        End If
calendrier_suivant:
    Next G
 
    If xTrouve = True Then
        Exit For
    End If
 
Next F
 
'If xTrouve = False Then
'    MsgBox "Calendrier : " & xCalendrier & " non trouvé !!!!", vbCritical, "CALENDRIER"
'    Exit Sub
'End If
 
 
'--------------------------------------------------------------------------------------
 
' Suite
 
'--------------------------------------------------------------------------------------
 
If MonSousDoss <> Empty Then
 
Set FolderPartage = objNavFolder.Folder
 
On Error GoTo 0
 
'---------------------------------------------------------
 
' Création du RDV
 
'---------------------------------------------------------
 
Dim ObjRDV As Outlook.AppointmentItem
 
Set ObjRDV = FolderPartage.Items.Add
 
xStart = xHeurDeb
 
With ObjRDV
 
.Subject = xTitre
 
.SendUsingAccount = objNS.Session.Accounts.Item(2)
 
.MeetingStatus = olMeeting
 
.body = xBody
 
.Start = xStart
 
.Duration = xDuree 'Valeur entière (exemple 30) exprimée en minutes
 
.Location = xLieu
 
'.Send
 
Set myRequiredAttendee = ObjRDV.Recipients.Add(mailFormateur)
myRequiredAttendee.Type = olRequired
Set myOptionalAttendee = ObjRDV.Recipients.Add(mailNouvelArrivant)
myOptionalAttendee.Type = olRequired
If xLieu Like "*salle*" Or xLieu Like "*fgr*" Or xLieu Like "*sds*" Then
    Set myResourceAttendee = ObjRDV.Recipients.Add(xLieu)
    myResourceAttendee.Type = olRequired
End If
 
.Display 'Mettre en commentaire après mise au point
'.Save
 
End With
 
End If
 
End Sub

Merci d'avance pour votre aide

[Oliv-]

Le premier code me semble pas mal!
mais si tu ajoutes le user , c'est normal qu'il le retrouve dans son calendrier !

Code :

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

 .Recipients.Add ("personne.un@outlook.com")

[Nouvel arriviste]

Bonjour Oliv,

Cette ligne concerne les personnes invitées à la réunion.

J'ai 2 comptes, A et B. Si A est l'adresse principal alors la réunion (AppointmentItem) ce crée dans le calendrier de A. Si B est le compte principal, alors la réunion est sur Calendrier de B. Ce que je souhaite c'est cette réunion (AppointmentItem) soit systématiquement sur B. Je ne parviens pas à changer le comte qui crée la réunion. Même avec la fonction SendUsingAccount.

En revanche cette fonction marche avec les mails. La différence c'est que quand on crée une réunion, on ne peut pas changer la personne qui l’envoie, même manuellement. Il faut se placer dans le bon calendrier. Ce que je ne parviens pas à faire sur VBA.

Du coup, comment je peux faire pour que ma réunion soit sur le calendrier de creation.rdv@outlook.com (le compte B que j'ai cité au-dessus) plutôt que sur le calendrier du compte principal (le compte A : nouvel.arriviste@outlook.com).

Cordialement

[Oliv-]

Chez moi ce code fonctionne
j'ai ajouté la ligne .MeetingStatus = olMeeting

attention pour que cela marche il faut que la personne qui lance le code ait les droits suffisants sur la boite partagée qui va être le propriétaire de la réunion.

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
Sub MeetingFromSharedMailbox()
    Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
    Dim olAppt As Outlook.AppointmentItem
 
    Dim olNS As Outlook.NameSpace
    Dim objOwner As Outlook.Recipient
 
    Set olNS = olApp.GetNamespace("MAPI")
    Set objOwner = olNS.CreateRecipient("creation.rdv@outlook.com")
    objOwner.Resolve
 
    If objOwner.Resolved Then
        'MsgBox objOwner.Name
        Set newCalFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
 
        'Now create the email
        Set olAppt = newCalFolder.Items.add(olAppointmentItem)
        With olAppt
 
            'Define calendar item properties
            .Start = "17/11/2020 3:00 PM"
            .End = "17/11/2020 3:30 PM"
            .Subject = "Appointment Subject Here"
            .MeetingStatus = olMeeting
            .Recipients.add ("nouvel.arriviste@outlook.com")
 
            'Add more variables as required, eg reminder, importance, etc
            .Display
            .Send
        End With
    End If
 
End Sub