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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
| Option Explicit
'25-IX-2008:
Private Sub cmdGrupos_Click()
On Error GoTo 0
Application.ScreenUpdating = False
Dim ModeRecalcul As Long
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Purge existing data
shtGrupos.Range("A3:L65000").ClearContents
'Session Manager declaration
Dim SessionManager As SessionMgr, Sess As SessionMgr
'Enterprise Session declaration
Dim esession As EnterpriseSession
'InfoStore declaration
Dim IStore As InfoStore
'Grupos.
Dim MisGrupos As InfoObjects
Dim MiGrupo As InfoObject
'Usuarios.
Dim MisUsuarios As InfoObjects
Dim strUsuarios As String
Dim lngUsuario As Long
Dim Rng As Excel.Range
Dim RowNum As Long
Dim ErrorState As String
'Dim test
'Session Manager instanciation
Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")
'Enterprise Session instanciation
Set esession = SessionManager.Logon(DameUserName(), DamePassword(), DameCMS(), "secEnterprise")
'Infostore instanciation
Set IStore = esession.Service("", "InfoStore")
'document the reports
Set MisGrupos = IStore.Query( _
"SELECT TOP 1000000 SI_ID, SI_NAME, SI_DESCRIPTION, SI_GROUP_MEMBERS FROM CI_SYSTEMOBJECTS " & _
"Where SI_KIND='UserGroup' ORDER BY SI_NAME")
RowNum = 2
Set Rng = shtGrupos.Cells
'Write in the top the server/login used, the update date
Rng(1, 2) = Date & " " & Time
For Each MiGrupo In MisGrupos
RowNum = RowNum + 1
Rng(RowNum, 1) = MiGrupo.ID
Rng(RowNum, 2) = MiGrupo.Title
Rng(RowNum, 3) = MiGrupo.Description
Rng(RowNum, 5) = "INFORMATIQUE"
Rng(RowNum, 6) = "DSI"
'recherche Infocentre et Carmi concernée
Call initinfo(MiGrupo, Rng, RowNum)
'Buscar los usuarios de este grupo.
strUsuarios = ""
If MiGrupo.PluginInterface.Users.Count > 0 Then
For lngUsuario = 1 To MiGrupo.PluginInterface.Users.Count
If lngUsuario = 1 Then
strUsuarios = CStr(MiGrupo.PluginInterface.Users(lngUsuario))
Else
strUsuarios = strUsuarios & "," & CStr(MiGrupo.PluginInterface.Users(lngUsuario))
End If
Next lngUsuario
Set MisUsuarios = IStore.Query("SELECT SI_NAME " & _
"FROM CI_SYSTEMOBJECTS " & _
"WHERE SI_KIND='User' " & _
"AND SI_ID IN (" & strUsuarios & ") " & _
"ORDER BY SI_NAME")
strUsuarios = ""
For lngUsuario = 1 To MisUsuarios.Count
If lngUsuario > 1 Then
RowNum = RowNum + 1
Rng(RowNum, 1) = MiGrupo.ID
Rng(RowNum, 2) = MiGrupo.Title
Rng(RowNum, 3) = MiGrupo.Description
Rng(RowNum, 5) = "INFORMATIQUE"
Rng(RowNum, 6) = "DSI"
'recherche Infocentre et Carmi concernée
Call initinfo(MiGrupo, Rng, RowNum)
strUsuarios = ""
End If
If Len(strUsuarios) > 0 Then
strUsuarios = strUsuarios & vbLf
End If
strUsuarios = strUsuarios & MisUsuarios(lngUsuario).Title
Rng(RowNum, 4) = LCase(strUsuarios)
If (strUsuarios Like "*gdr *" Or strUsuarios Like "*test*" Or strUsuarios Like "*TEST*") Then
Rng(RowNum, 5) = "INFORMATIQUE"
Rng(RowNum, 6) = "DSI"
End If
Next lngUsuario
Else
RowNum = RowNum - 1
End If
'Rng(RowNum, 4) = strUsuarios
Next MiGrupo
Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
CleanUp:
On Error Resume Next
esession.Logoff
Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
Call MsgBox("Data OK", vbInformation, "MAJ Groupes")
Exit Sub
ErrorHandler:
If Err.Number = -2147210697 Then
If ErrorState = "FullName" Then Rng(RowNum, 3) = "Error on Full Name"
If ErrorState = "LastLogon" Then Rng(RowNum, 9) = ""
Resume Next
End If
MsgBox Err.Source & " - " & Err.Number & ": " & Err.Description & " " & Err.HelpContext, _
vbCritical, "Failure in UsersGroups()"
Resume CleanUp
End Sub
Sub initinfo(MiGrupo, Rng, RowNum)
'recherche Infocentre et Carmi concernée
If Not (MiGrupo.Title Like "*BO_AVAN*" Or MiGrupo.Title Like "*DEV*" Or MiGrupo.Title Like "*TEST*" Or MiGrupo.Title Like "*TSTU*") Then
If MiGrupo.Title Like "*CASS*" Then
Rng(RowNum, 5) = "CASSIOPEE"
Else
If MiGrupo.Title Like "*AGST*" Or MiGrupo.Title Like "AS *" Then
Rng(RowNum, 5) = "AGENSTAT"
Else
If MiGrupo.Title Like "*CASC*" Then
Rng(RowNum, 5) = "CASCADES"
Else
If MiGrupo.Title Like "*GDR*" Then
Rng(RowNum, 5) = "GDR"
Else
If MiGrupo.Title Like "*PAREOS*" Then
Rng(RowNum, 5) = "PAREOS"
Rng(RowNum, 6) = "CARMI DU SUD EST"
Else
If MiGrupo.Title Like "*PRIAM*" Then
Rng(RowNum, 5) = "PRIAM"
Else
If MiGrupo.Title Like "*PLE*" Then
Rng(RowNum, 5) = "PLEIADES"
Else
If MiGrupo.Title Like "*COG*" Then
Rng(RowNum, 5) = "COG-CPG"
Else
If MiGrupo.Title Like "*GPEC*" Then
Rng(RowNum, 5) = "GPEC"
Else
If MiGrupo.Title Like "*MUT*" Then
Rng(RowNum, 5) = "MUTUALISATION"
Else
If MiGrupo.Title Like "*SCR*" Then
Rng(RowNum, 5) = "SCRIBE"
Else
If MiGrupo.Title Like "*SIR*" Then
Rng(RowNum, 5) = "INFORMATIQUE"
Else
If MiGrupo.Title Like "*TBG*" Then
Rng(RowNum, 5) = "TABLEAUX DE BORD"
Else
If MiGrupo.Title Like "*UDAS*" Then
Rng(RowNum, 5) = "UDAS"
Else
If MiGrupo.Title Like "Controle Interne CANSSM" Then
Rng(RowNum, 5) = "Contrôle Interne"
Else
If MiGrupo.Title Like "Controle Interne CENTRE OUEST" Then
Rng(RowNum, 5) = "Contrôle Interne"
Else
If MiGrupo.Title Like "Controle Interne EST" Then
Rng(RowNum, 5) = "Contrôle Interne"
Else
If MiGrupo.Title Like "Controle Interne NPDC" Then
Rng(RowNum, 5) = "Contrôle Interne"
Else
If MiGrupo.Title Like "Controle Interne SUD EST" Then
Rng(RowNum, 5) = "Contrôle Interne"
Else
If MiGrupo.Title Like "Controle Interne SUD OUEST" Then
Rng(RowNum, 5) = "Contrôle Interne"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If MiGrupo.Title Like "*NORD*" Or MiGrupo.Title Like "*NPDC*" Or MiGrupo.Title Like "*NPC*" Then
Rng(RowNum, 6) = "CARMI DU NORD-PAS DE CALAIS"
Else
If MiGrupo.Title Like "*CENTRE EST*" Or MiGrupo.Title Like "*CE*" Then
Rng(RowNum, 6) = "CARMI DU CENTRE EST"
Else
If MiGrupo.Title Like "*CENTRE*" Then
Rng(RowNum, 6) = "CARMI DU CENTRE"
Else
If MiGrupo.Title Like "*SUD EST*" Or MiGrupo.Title Like "*SE*" Then
Rng(RowNum, 6) = "CARMI DU SUD EST"
Else
If MiGrupo.Title Like "*SUD OUEST*" Or MiGrupo.Title Like "*SO*" Then
Rng(RowNum, 6) = "CARMI DU SUD OUEST"
Else
If MiGrupo.Title Like "*OUEST*" Then
Rng(RowNum, 6) = "CARMI DE l'OUEST"
Else
If MiGrupo.Title Like "* EST*" Or MiGrupo.Title Like "AGST CARMI" Then
Rng(RowNum, 6) = "CARMI DE L'EST"
Else
If MiGrupo.Title Like "*CANSSM*" Then
Rng(RowNum, 6) = "CANSSM"
Else
If MiGrupo.Title Like "*GPEC*" Then
Rng(RowNum, 6) = MiGrupo.Title
Else
If MiGrupo.Title Like "*SIR*" Then
Rng(RowNum, 6) = "DSI"
Else
If MiGrupo.Title Like "*ANGDM*" Then
Rng(RowNum, 6) = "ANGDM"
Else
If MiGrupo.Title Like "*GDR*" Or MiGrupo.Title Like "*PAREOS*" Or MiGrupo.Title Like "*PRIAM*" Or MiGrupo.Title Like "*MUT_*" Then
Rng(RowNum, 6) = MiGrupo.Title
Else
Rng(RowNum, 6) = MiGrupo.Title & " (organisme à ajouter)"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If MiGrupo.Title Like "*CRE*" Or MiGrupo.Title Like "*AVAN*" Or MiGrupo.Title Like "*MODIF*" Or MiGrupo.Title Like "*BO_UTIL_G15*" Or MiGrupo.Title Like "*PLEIADES*" Or MiGrupo.Title Like "*SCRIBE*" Or MiGrupo.Title Like "*UDAS*" Then
Rng(RowNum, 7) = "Créateur"
Else
Rng(RowNum, 7) = "Visualisateur"
End If
'FIN recherche Infocentre et Carmi concernée
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub |
