Discussion :

[marmelade]

Bonjour

Je souhaite developper en VBA Outlook une macro qui initie une réunion SKYPE ou TEAMS. L'action serait équivalente de cliquer sur un des deux boutons suivants


Idéalement que ça aille jusqu'à l'envoie aux correspondants avec date et heure de fin

D'avance merci

[Oliv-]

Bonjour,

C'est un peu compliqué, car SKYPE est ici un complément.

mais ce code chez moi fonctionne

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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
Option Compare Text
Option Explicit
 
 
Private Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As Object, ByVal iChildStart As Long, _
        ByVal cChildren As Long, ByRef rgvarChildren As Variant, _
        ByRef pcObtained As Long) As Long
 
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa() As Any) As Long
 
Private Const CHILDID_SELF As Long = &H0&
Private Const STATE_SYSTEM_UNAVAILABLE As Long = &H1&
Private Const STATE_SYSTEM_INVISIBLE As Long = &H8000&
Private Const STATE_SYSTEM_SELECTED As Long = &H2&
 
Private Enum RoleNumber
    ROLE_SYSTEM_CLIENT = &HA&
    ROLE_SYSTEM_PANE = &H10&
    ROLE_SYSTEM_GROUPING = &H14&
    ROLE_SYSTEM_TOOLBAR = &H16&
    ROLE_SYSTEM_PAGETAB = &H25&
    ROLE_SYSTEM_PROPERTYPAGE = &H26&
    ROLE_SYSTEM_GRAPHIC = &H28&
    ROLE_SYSTEM_STATICTEXT = &H29&
    ROLE_SYSTEM_TEXT = &H2A&
    ROLE_SYSTEM_BUTTONDROPDOWNGRID = &H3A&
    ROLE_SYSTEM_PAGETABLIST = &H3C&
End Enum
 
Private Enum NavigationDirection
    NAVDIR_FIRSTCHILD = &H7&
End Enum
 
 
 
Public Sub add_Skype_to_Meeting()
'---------------------------------------------------------------------------------------
' Procedure : add_meeting_skype
' Author    : OCTU
' Date      : 27/02/2019
' Purpose   :
'---------------------------------------------------------------------------------------
'
 
    Dim btn
    btn = "OnUCExplorerOnActionO14"
    Dim maReunion As AppointmentItem
 
    Dim olApp
    If Application.Name = "Outlook" Then
        Set olApp = Application
    Else
        Set olApp = CreateObject("outlook.application")
    End If
 
 
    Set maReunion = olApp.CreateItem(olAppointmentItem)
    maReunion.MeetingStatus = olMeeting
 
    Dim myRequiredAttendee As Outlook.Recipient
    Dim myOptionalAttendee As Outlook.Recipient
    Dim myResourceAttendee As Outlook.Recipient
 
    maReunion.Subject = "Test SKYPE"
    maReunion.Location = "Conference Room"
    maReunion.Start = #4/1/2019 1:00:00 PM#
    maReunion.Duration = 60
 
    Set myRequiredAttendee = maReunion.Recipients.Add("SDCL")
    myRequiredAttendee.Type = olRequired
 
    'Set myOptionalAttendee = maReunion.Recipients.add("Kevin Kennedy")
    'myOptionalAttendee.Type = olOptional
 
    '    Set myResourceAttendee = maReunion.Recipients.add("Conference Room B")
    '    myResourceAttendee.Type = olResource
 
    maReunion.Body = "Bonjour à tous," & Chr(10) & _
            "" & Chr(10) & _
            "" & Chr(10) & _
            "" & Chr(10) & _
            "" & Chr(10) & _
            "" & Chr(10)
 
 
 
    maReunion.Display
    DoEvents
    'on ajoute skype
    If ClickBtnInsp("Réunion Skype") Then
        DoEvents
        maReunion.Send
    Else
        MsgBox "KO"
        Stop
    End If
End Sub
 
'---------------------------------------------------------------------------------------
' Module    : https://www.rholtz-office.de/ribbonx/ein-beliebiges-tab-aktivieren
' Author    : René Holtz
' Date      : 27/02/2019 10:41
' Purpose   :
'---------------------------------------------------------------------------------------
 
 
Private Function GetAccessibleVisible(ByRef probjElement As IAccessible, ByVal pvenmRoleWanted As RoleNumber, _
        ByVal pvstrNameWanted As String, Optional ByVal opvblnGetClient As Boolean) As IAccessible
 
    Dim avntChildrenArray() As Variant
    Dim objChild As IAccessible
    Dim objReturnElement As IAccessible
    Dim ialngChild As Long
    Dim strNameComparand As String
    Dim strName As String
    Dim strValue As String
 
    On Error Resume Next
 
    strValue = probjElement.accValue(CHILDID_SELF)
 
    On Error GoTo 0
 
    strName = probjElement.accName(CHILDID_SELF)
 
    Select Case strValue
 
    Case "Ribbon", "Quick Access Toolbar", "Ribbon Tabs List", "Lower Ribbon", "Status Bar"
        strNameComparand = strValue
    Case vbNullString, "Ribbon Tab", "Group"
        strNameComparand = strName
    Case Else
        strNameComparand = strName
 
    End Select
 
 
    If probjElement.accRole(CHILDID_SELF) = pvenmRoleWanted And strNameComparand = pvstrNameWanted And (probjElement.accState(CHILDID_SELF) And (STATE_SYSTEM_UNAVAILABLE Or STATE_SYSTEM_INVISIBLE)) = 0 Then
        Set objReturnElement = probjElement
    Else
        avntChildrenArray = GetChildren(probjElement)
 
        If CBool(SafeArrayGetDim(avntChildrenArray)) Then
            For ialngChild = LBound(avntChildrenArray) To UBound(avntChildrenArray)
                If TypeOf avntChildrenArray(ialngChild) Is IAccessible Then
                    Set objChild = avntChildrenArray(ialngChild)
                    Set objReturnElement = GetAccessibleVisible(objChild, pvenmRoleWanted, pvstrNameWanted)
                    If Not objReturnElement Is Nothing Then Exit For
                End If
            Next
        End If
    End If
 
    If opvblnGetClient Then Set objReturnElement = objReturnElement.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
 
    Set GetAccessibleVisible = objReturnElement
    Set objReturnElement = Nothing
    Set objChild = Nothing
 
End Function
Private Function GetAccessible(ByRef probjElement As IAccessible, ByVal pvenmRoleWanted As RoleNumber, _
        ByVal pvstrNameWanted As String, Optional ByVal opvblnGetClient As Boolean) As IAccessible
 
    Dim avntChildrenArray() As Variant
    Dim objChild As IAccessible
    Dim objReturnElement As IAccessible
    Dim ialngChild As Long
    Dim strNameComparand As String
    Dim strName As String
    Dim strValue As String
 
    On Error Resume Next
 
    strValue = probjElement.accValue(CHILDID_SELF)
 
    On Error GoTo 0
 
    strName = probjElement.accName(CHILDID_SELF)
 
    Select Case strValue
 
    Case "Ribbon", "Quick Access Toolbar", "Ribbon Tabs List", "Lower Ribbon", "Status Bar"
        strNameComparand = strValue
    Case vbNullString, "Ribbon Tab", "Group"
        strNameComparand = strName
    Case Else
        strNameComparand = strName
 
    End Select
 
    If probjElement.accRole(CHILDID_SELF) = pvenmRoleWanted And strNameComparand = pvstrNameWanted Then
        Set objReturnElement = probjElement
    Else
        avntChildrenArray = GetChildren(probjElement)
 
        If CBool(SafeArrayGetDim(avntChildrenArray)) Then
            For ialngChild = LBound(avntChildrenArray) To UBound(avntChildrenArray)
                If TypeOf avntChildrenArray(ialngChild) Is IAccessible Then
                    Set objChild = avntChildrenArray(ialngChild)
                    Set objReturnElement = GetAccessible(objChild, pvenmRoleWanted, pvstrNameWanted)
                    If Not objReturnElement Is Nothing Then Exit For
                End If
            Next
        End If
    End If
 
    If opvblnGetClient Then Set objReturnElement = objReturnElement.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
 
    Set GetAccessible = objReturnElement
    Set objReturnElement = Nothing
    Set objChild = Nothing
 
End Function
 
Private Function GetChildren(ByRef probjElement As IAccessible) As Variant()
 
    Const FIRST_CHILD As Long = 0&
    Dim lngChildCount As Long
    Dim lngReturn As Long
    Dim avntChildrenArray() As Variant
 
    lngChildCount = probjElement.accChildCount
 
    If lngChildCount > 0 Then
        ReDim avntChildrenArray(lngChildCount - 1)
        Call AccessibleChildren(probjElement, FIRST_CHILD, lngChildCount, avntChildrenArray(0), lngReturn)
    End If
 
    GetChildren = avntChildrenArray
 
End Function
 
 
 
 
Private Function ClickBtnInsp(Name As String) As Boolean
    ClickBtnInsp = False
    Dim RibbonBtn As IAccessible
    Dim i
    Set RibbonBtn = GetAccessible(ActiveInspector.CommandBars("Ribbon"), _
            43, _
            Name)
 
    If Not RibbonBtn Is Nothing Then
        If ((RibbonBtn.accState(CHILDID_SELF) _
                And (STATE_SYSTEM_UNAVAILABLE Or _
                STATE_SYSTEM_INVISIBLE)) = 0) Then
            RibbonBtn.accDoDefaultAction CHILDID_SELF
            ClickBtnInsp = True
        End If
    End If
End Function

[atxeco]

Merci pour ton code qui fonctionne parfaitement avec Skype, mais malheureusement pas avec Teams.
J'ai essayé de changer le nom du bouton pour Teams, mais cela ne fonctionne pas.

As-tu une idée des modifications à apporter pour qu'il fonctionne avec Teams ? Je cherche de mon côté, et posterai le code si je trouve

[atxeco]

Après avoir creusé un peu, j'ai trouvé pourquoi le code ne fonctionne pas pour organiser une réunion Teams : le souci vient du test

Code :

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

If ((RibbonBtn.accState(CHILDID_SELF) And (STATE_SYSTEM_UNAVAILABLE Or STATE_SYSTEM_INVISIBLE)) = 0)

Dans Inspect, les 2 boutons ont le même accState valorisé à &h100000, mais dans VBA, le accState du bouton Skype est bien &h100000 alors que le accState du bouton Teams est &h8001 -> le bouton Teams ne passe pas le test.

Je ne sais pas pourquoi VBA ne donne pas le même accState aux 2 boutons.

Du coup, j'ai juste supprimé le test et ma réunions Teams est bien créée.