Bonjour,

Suite à l'aide que m'a apporté ce forum, je tiens a mettre dispo ma source de projet.

Plusieurs notions abordées :
- Active directory :
**- Lister les organisations
**- Créer un utilisateurs avec parametres
**- Renseigner le profil de services TSE (nécessite wts_adim.dll)
**- Ajouter des groupes pour un utilisateur
- Exchange
**- Céation des boites au lettres
**- Gérer les adresses
**- Envoyer un Mail
- Dossiers :
**- Créer un dossier
**- Paramétrer les autorisations du dossier
...

J'ai mis pas mal de temps à le faire (ne pratiquant pas VB tous les jours)
Ceci pourra être utile à d'autres, administrateurs ou pas. Libre à vous de le remanier.
Il est fait pour mes besoins (j'ai modifié quelques trucs, car spécifiques à mon entreprise), mais vous verrez.
J'ai mis tout le code pour qu'il soit récupérable à 100%
Voila bonne prog

Form1.vb
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
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
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
 
Public Class Form1
    Inherits System.Windows.Forms.Form
 
#Region " Code généré par le Concepteur Windows Form "
 
    Public Sub New()
        MyBase.New()
 
        'Cet appel est requis par le Concepteur Windows Form.
        InitializeComponent()
 
        'Ajoutez une initialisation quelconque après l'appel InitializeComponent()
 
    End Sub
 
    'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub
 
    'Requis par le Concepteur Windows Form
    Private components As System.ComponentModel.IContainer
 
    'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
    'Elle peut être modifiée en utilisant le Concepteur Windows Form.  
    'Ne la modifiez pas en utilisant l'éditeur de code.
    Friend WithEvents Arborescence As System.Windows.Forms.TreeView
    Friend WithEvents LblGroupe As System.Windows.Forms.Label
    Friend WithEvents lblsite As System.Windows.Forms.Label
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents Label2 As System.Windows.Forms.Label
    Friend WithEvents txtnom As System.Windows.Forms.TextBox
    Friend WithEvents txtprenom As System.Windows.Forms.TextBox
    Friend WithEvents lblnom As System.Windows.Forms.Label
    Friend WithEvents lblprenom As System.Windows.Forms.Label
    Friend WithEvents txtMdp As System.Windows.Forms.TextBox
    Friend WithEvents txtUsername As System.Windows.Forms.TextBox
    Friend WithEvents btnGenerer As System.Windows.Forms.Button
    Friend WithEvents lblusername As System.Windows.Forms.Label
    Friend WithEvents txtnomdetaille As System.Windows.Forms.TextBox
    Friend WithEvents btnvalider As System.Windows.Forms.Button
    Friend WithEvents chklist As System.Windows.Forms.CheckedListBox
    Friend WithEvents btnchoix As System.Windows.Forms.Button
    Friend WithEvents lstadresses As System.Windows.Forms.ListBox
    Friend WithEvents btncreer As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
        Me.Arborescence = New System.Windows.Forms.TreeView()
        Me.LblGroupe = New System.Windows.Forms.Label()
        Me.lblsite = New System.Windows.Forms.Label()
        Me.Label1 = New System.Windows.Forms.Label()
        Me.Label2 = New System.Windows.Forms.Label()
        Me.txtnom = New System.Windows.Forms.TextBox()
        Me.txtprenom = New System.Windows.Forms.TextBox()
        Me.lblnom = New System.Windows.Forms.Label()
        Me.lblprenom = New System.Windows.Forms.Label()
        Me.txtMdp = New System.Windows.Forms.TextBox()
        Me.txtUsername = New System.Windows.Forms.TextBox()
        Me.btnGenerer = New System.Windows.Forms.Button()
        Me.lblusername = New System.Windows.Forms.Label()
        Me.txtnomdetaille = New System.Windows.Forms.TextBox()
        Me.btnvalider = New System.Windows.Forms.Button()
        Me.chklist = New System.Windows.Forms.CheckedListBox()
        Me.btnchoix = New System.Windows.Forms.Button()
        Me.lstadresses = New System.Windows.Forms.ListBox()
        Me.btncreer = New System.Windows.Forms.Button()
        Me.SuspendLayout()
        '
        'Arborescence
        '
        Me.Arborescence.ImageIndex = -1
        Me.Arborescence.Location = New System.Drawing.Point(16, 24)
        Me.Arborescence.Name = "Arborescence"
        Me.Arborescence.SelectedImageIndex = -1
        Me.Arborescence.Size = New System.Drawing.Size(168, 384)
        Me.Arborescence.TabIndex = 0
        '
        'LblGroupe
        '
        Me.LblGroupe.Font = New System.Drawing.Font("Arial", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.LblGroupe.Location = New System.Drawing.Point(256, 32)
        Me.LblGroupe.Name = "LblGroupe"
        Me.LblGroupe.Size = New System.Drawing.Size(136, 24)
        Me.LblGroupe.TabIndex = 1
        '
        'lblsite
        '
        Me.lblsite.Font = New System.Drawing.Font("Arial", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.lblsite.Location = New System.Drawing.Point(232, 56)
        Me.lblsite.Name = "lblsite"
        Me.lblsite.Size = New System.Drawing.Size(136, 24)
        Me.lblsite.TabIndex = 2
        '
        'Label1
        '
        Me.Label1.Font = New System.Drawing.Font("Arial", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label1.Location = New System.Drawing.Point(192, 56)
        Me.Label1.Name = "Label1"
        Me.Label1.Size = New System.Drawing.Size(40, 24)
        Me.Label1.TabIndex = 3
        Me.Label1.Text = "Site : "
        '
        'Label2
        '
        Me.Label2.Font = New System.Drawing.Font("Arial", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Label2.Location = New System.Drawing.Point(192, 32)
        Me.Label2.Name = "Label2"
        Me.Label2.Size = New System.Drawing.Size(64, 24)
        Me.Label2.TabIndex = 4
        Me.Label2.Text = "Groupe :"
        '
        'txtnom
        '
        Me.txtnom.Location = New System.Drawing.Point(232, 128)
        Me.txtnom.Name = "txtnom"
        Me.txtnom.Size = New System.Drawing.Size(160, 22)
        Me.txtnom.TabIndex = 5
        Me.txtnom.Text = ""
        '
        'txtprenom
        '
        Me.txtprenom.Location = New System.Drawing.Point(232, 176)
        Me.txtprenom.Name = "txtprenom"
        Me.txtprenom.Size = New System.Drawing.Size(160, 22)
        Me.txtprenom.TabIndex = 6
        Me.txtprenom.Text = ""
        '
        'lblnom
        '
        Me.lblnom.Location = New System.Drawing.Point(232, 104)
        Me.lblnom.Name = "lblnom"
        Me.lblnom.Size = New System.Drawing.Size(144, 24)
        Me.lblnom.TabIndex = 7
        Me.lblnom.Text = "Nom de famille :"
        '
        'lblprenom
        '
        Me.lblprenom.Location = New System.Drawing.Point(232, 152)
        Me.lblprenom.Name = "lblprenom"
        Me.lblprenom.Size = New System.Drawing.Size(144, 24)
        Me.lblprenom.TabIndex = 8
        Me.lblprenom.Text = "Prénom :"
        '
        'txtMdp
        '
        Me.txtMdp.Location = New System.Drawing.Point(232, 280)
        Me.txtMdp.Name = "txtMdp"
        Me.txtMdp.Size = New System.Drawing.Size(144, 22)
        Me.txtMdp.TabIndex = 9
        Me.txtMdp.Text = "mot de passe"
        '
        'txtUsername
        '
        Me.txtUsername.Location = New System.Drawing.Point(232, 240)
        Me.txtUsername.Name = "txtUsername"
        Me.txtUsername.Size = New System.Drawing.Size(136, 22)
        Me.txtUsername.TabIndex = 10
        Me.txtUsername.Text = "Nom d'utilisateur"
        '
        'btnGenerer
        '
        Me.btnGenerer.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.btnGenerer.Font = New System.Drawing.Font("Microsoft Sans Serif", 11.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.btnGenerer.Location = New System.Drawing.Point(232, 384)
        Me.btnGenerer.Name = "btnGenerer"
        Me.btnGenerer.Size = New System.Drawing.Size(80, 24)
        Me.btnGenerer.TabIndex = 11
        Me.btnGenerer.Text = "Generer"
        '
        'lblusername
        '
        Me.lblusername.Location = New System.Drawing.Point(232, 208)
        Me.lblusername.Name = "lblusername"
        Me.lblusername.Size = New System.Drawing.Size(144, 24)
        Me.lblusername.TabIndex = 12
        Me.lblusername.Text = "Nom d'utilisateur :"
        '
        'txtnomdetaille
        '
        Me.txtnomdetaille.Location = New System.Drawing.Point(232, 328)
        Me.txtnomdetaille.Name = "txtnomdetaille"
        Me.txtnomdetaille.Size = New System.Drawing.Size(208, 22)
        Me.txtnomdetaille.TabIndex = 13
        Me.txtnomdetaille.Text = "Nom Détaillé"
        '
        'btnvalider
        '
        Me.btnvalider.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.btnvalider.Font = New System.Drawing.Font("Microsoft Sans Serif", 11.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.btnvalider.Location = New System.Drawing.Point(336, 384)
        Me.btnvalider.Name = "btnvalider"
        Me.btnvalider.Size = New System.Drawing.Size(80, 24)
        Me.btnvalider.TabIndex = 14
        Me.btnvalider.Text = "Valider"
        '
        'chklist
        '
        Me.chklist.Font = New System.Drawing.Font("Arial", 9.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.chklist.Items.AddRange(New Object() {"Messagerie interne", "Messagerie externe", "Office"})
        Me.chklist.Location = New System.Drawing.Point(16, 440)
        Me.chklist.Name = "chklist"
        Me.chklist.Size = New System.Drawing.Size(168, 84)
        Me.chklist.TabIndex = 15
        '
        'btnchoix
        '
        Me.btnchoix.Location = New System.Drawing.Point(16, 528)
        Me.btnchoix.Name = "btnchoix"
        Me.btnchoix.Size = New System.Drawing.Size(136, 32)
        Me.btnchoix.TabIndex = 16
        Me.btnchoix.Text = "Valider les choix"
        '
        'lstadresses
        '
        Me.lstadresses.ItemHeight = 16
        Me.lstadresses.Location = New System.Drawing.Point(184, 440)
        Me.lstadresses.Name = "lstadresses"
        Me.lstadresses.Size = New System.Drawing.Size(160, 84)
        Me.lstadresses.TabIndex = 17
        '
        'btncreer
        '
        Me.btncreer.Location = New System.Drawing.Point(360, 448)
        Me.btncreer.Name = "btncreer"
        Me.btncreer.Size = New System.Drawing.Size(96, 40)
        Me.btncreer.TabIndex = 18
        Me.btncreer.Text = "Creer Utilisateur"
        '
        'Form1
        '
        Me.AccessibleName = "Form1"
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 15)
        Me.BackColor = System.Drawing.SystemColors.ActiveBorder
        Me.ClientSize = New System.Drawing.Size(464, 565)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.btncreer, Me.lstadresses, Me.btnchoix, Me.chklist, Me.btnvalider, Me.txtnomdetaille, Me.lblusername, Me.btnGenerer, Me.txtUsername, Me.txtMdp, Me.lblprenom, Me.lblnom, Me.txtprenom, Me.txtnom, Me.Label2, Me.Label1, Me.lblsite, Me.LblGroupe, Me.Arborescence})
        Me.Font = New System.Drawing.Font("Arial", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Name = "Form1"
        Me.Text = "Creation Utilisateurs"
        Me.ResumeLayout(False)
 
    End Sub
 
#End Region
 
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
        'AD
        DomainName = "DC=pipo,DC=fr"
        FQDN = "pipo.fr"
        DomaineNetbios = "pipo"
        DCServer = "TOTO"
 
        'Exchange
        EXCHServer = "TOTO"
        OrganisationExchange = "Exchange pipo"
        CheminADExchange = "CN=Banque de boîtes aux lettres (" & EXCHServer & ")" & _
              ",CN=Premier groupe de stockage,CN=InformationStore,CN=" & EXCHServer & _
              ",CN=Servers,CN=Premier groupe d'administration,CN=Administrative Groups" & _
              ",CN=" & OrganisationExchange & ",CN=Microsoft Exchange" & _
              ",CN=Services,CN=Configuration," & DomainName
 
 
 
        'Office
        CheminRessources = "\\127.0.0.1\Utilisateurs"
 
        Module1.form2 = New Mail()
        Module1.form2.Hide()
 
 
        Dim dom As Object
        Dim ou As Object
        Dim OUprincipale As String
        Dim i As Integer
        Dim Ou1
        Dim dom1
        Dim ObjDom As Object
        Dim ObjDom1 As Object
        Dim node As TreeNode
        btnchoix.Hide()
        btncreer.Enabled = False
        lstadresses.Hide()
        chklist.Hide()
        btnvalider.Enabled = False
        txtUsername.Enabled = False
        txtMdp.Enabled = False
        txtnomdetaille.Enabled = False
        ' Création du conteneur
        dom = GetObject("LDAP://" & DomainName)
        For Each ou In dom
            If ou.Class = "organizationalUnit" Then 'on filtre uniquement sur les organizationnalunit
                OUprincipale = ou.name
                'ajout d'un noeud principal pour le groupe
                node = Arborescence.Nodes.Add("- " & Mid(OUprincipale, 4))
                ' Création du  2eme conteneur
                dom1 = GetObject("LDAP://" & OUprincipale & "," & DomainName)
                For Each Ou1 In dom1
                    If Ou1.Class = "organizationalUnit" Then 'on filtre uniquement sur les organizationnalunit
                        'ajout d'un noeud secondaire pour le site
                        node.Nodes.Add(Mid(Ou1.name, 4))
                    End If
                Next
            End If
        Next
 
    End Sub
 
 
    Private Sub Arborescence_AfterSelect(ByVal sender As System.Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles Arborescence.AfterSelect
        If Microsoft.VisualBasic.Left(Arborescence.SelectedNode.Text, 1) = "-" Then
            LblGroupe.Text = Mid(Arborescence.SelectedNode.Text, 3)
            lblsite.Text = ""
        Else
            LblGroupe.Text = Mid(Arborescence.SelectedNode.Parent.Text, 3)
            lblsite.Text = Arborescence.SelectedNode.Text
        End If
 
    End Sub
 
    Private Sub btnGenerer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGenerer.Click
        'Permet de génerer les elements utilisateurs qui découlent du nom ainsi que du prénom
 
        Dim longueur
        Dim prenom
        Dim i
        Dim j
        Dim espace
        Dim Temprenom
        Dim Temp
        Dim Pass
        Dim Passtemp
        Dim lettre
        'On récupere la sélection du groupe et du site
        Module1.OUprincipale = "OU=" & LblGroupe.Text
        Module1.OUutilisateur = "OU=" & lblsite.Text
        'Nom
        Module1.nom = UCase(Module1.VerifString(txtnom.Text))
        txtnom.Text = Module1.nom
        'prénom
        'Premiere lettre du prénom en majuscule, le reste en minuscule
        prenom = LCase(txtprenom.Text)
        longueur = Len(prenom)
        j = 2
        espace = "Faux"
        Temprenom = UCase(Mid(prenom, 1, 1))
        While j < longueur + 1
            Temp = Mid(prenom, j, 1)
            If espace = "vrai" Then
                Temp = UCase(Temp)
                espace = "Faux"
            Else
                If Temp = " " Or Temp = "-" Then
                    espace = "vrai"
                End If
            End If
            Temprenom = Temprenom & Temp
            j = j + 1
        End While
        prenom = Temprenom
 
        Module1.prenom = prenom
        txtprenom.Text = Module1.prenom
        i = 7
        'Nom d'utilisateur
        'Ongere le cas ou il y a un espace ou un tirait dans le nom
        'Le nom d'utilisateur est comosé de la premiere lettre du pénom 
        'et des 7 premieres lettres du nom
        Module1.username = VerifEspace(Mid(Module1.prenom, 1, 1) & Mid(Module1.nom, 1, i))
        While Len(nom) > i And Len(username) < 8
            Module1.username = VerifEspace(Mid(Module1.prenom, 1, 1) & Mid(Module1.nom, 1, i))
            i = i + 1
        End While
        txtUsername.Text = Module1.username
 
 
        'Genere le mot de pass de 6 chiffres
        'Pas deux chifres qui se suivent et les chiffres tous differents
        Pass = Int(Rnd() * 10)
        i = 2
        While i < 7
            Passtemp = Int(Rnd() * 10)
            While (Passtemp = Microsoft.VisualBasic.Right(Pass, 1) + 1) Or (Passtemp = Microsoft.VisualBasic.Right(Pass, 1) - 1)
                Passtemp = Int(Rnd() * 10)
            End While
            j = 1
            While j < i
                lettre = Mid(Pass, j, 1)
                If lettre = Passtemp Then
                    Passtemp = Int(Rnd() * 10)
                    j = 0
                End If
                j = j + 1
            End While
            Pass = Pass & Passtemp
            i = i + 1
        End While
        Module1.Mdp = Pass
        txtMdp.Text = Module1.Mdp
 
        'Nom détaillé
        Module1.nomDetaille = Module1.nom & " " & Module1.prenom
        txtnomdetaille.Text = Module1.nomDetaille
 
        'On vérifie si tous les parametres sont renseignés
        If Module1.OUprincipale <> "OU=" And Module1.OUutilisateur <> "OU=" And Module1.nom <> "" And Module1.prenom <> "" Then
            btnvalider.Enabled = True
            txtUsername.Enabled = True
            txtMdp.Enabled = True
            txtnomdetaille.Enabled = True
        Else
            MsgBox("Veuillez rensiegner toutes les zone.", 16, "Attention !")
            btnvalider.Enabled = False
            txtUsername.Text = "nom d'utilisateur"
            txtMdp.Text = "Mot de passe"
            txtnomdetaille.Text = "Nom détaillé"
        End If
 
    End Sub
 
    Private Sub btnvalider_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnvalider.Click
        'On va tester si l'utilisateur n'est pas déja présent
        'grace à la fonction FindUser
        Dim result
        Module1.username = UCase(txtUsername.Text)
        result = Module1.FindUser()
        If result <> "Not Found" Then
            If FindUser() = "Trouve" Then
                MsgBox("Utilisateur déja présent.", 16, "Attention !")
            Else
                MsgBox(result, 16, "Attention !")
            End If
        Else
            btnvalider.Enabled = False
            btnGenerer.Enabled = False
            txtUsername.Enabled = False
            txtMdp.Enabled = False
            txtnomdetaille.Enabled = False
            txtnom.Enabled = False
            txtprenom.Enabled = False
            chklist.Show()
 
            btnchoix.Show()
        End If
 
 
 
 
 
 
 
    End Sub
 
    Private Sub btnchoix_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnchoix.Click
 
        'permet de passer les parametres facultatifs lors de la création de l'utilisateur
        PasDeMail = False
        btncreer.Enabled = True
        If chklist.GetItemChecked(0) Then
            If chklist.GetItemChecked(1) Then
                affichelstmail("externe")
            Else
                affichelstmail("interne")
            End If
        Else
            If chklist.GetItemChecked(1) Then
                affichelstmail("externe")
            Else
                PasDeMail = True
            End If
        End If
 
        If chklist.GetItemChecked(2) Then
            Office = True
        Else
            Office = False
        End If
    End Sub
    Public Function affichelstmail(ByVal type)
        'Fonction affichelstmail
        'Remplit la listBox lstadresses
        'Remplit le tableau de proxyadresses qui '"TblmMail" qui sera donné à Exchange
        'Les adresses aves "SMTP:" sont les adresses principales smtp
        'NbAdresses contient le nombre de lignes dans le tableau
        lstadresses.Items.Clear()
        'nombre d'aresses max, on peut l'augmenter
        ReDim TblMail(10)
        Dim i
        lstadresses.Show()
        NbAdresse = 0
        TblMail(0) = "X400:c=FR;a= ;p=" & OrganisationExchange & ";o=Exchange;s=" & nom & ";g=" & prenom & ";"
        If type = "externe" Then
            Mailexterne = True
            If Module1.OUprincipale = "OU=GROUPE1" Then
                NbAdresse = 3
                lstadresses.Items.Add(nom & "@GROUPE1.fr")
                TblMail(1) = "SMTP:" & nom & "@GROUPE1.fr"
                lstadresses.Items.Add(nom & "@Adr2GROUPE1.fr")
                TblMail(2) = "smtp:" & nom & "@Adr2GROUPE1.fr"
                lstadresses.Items.Add(nom & "@" & FQDN)
                TblMail(NbAdresse) = "smtp:" & username & "@" & FQDN
            Else
                If OUprincipale = "OU=GROUPE3" Then
                    NbAdresse = 2
                    lstadresses.Items.Add(username & "@GROUPE3.fr")
                    TblMail(1) = "SMTP:" & username & "@GROUPE3.fr"
                    lstadresses.Items.Add(username & "@" & FQDN)
                    TblMail(NbAdresse) = "smtp:" & username & "@" & FQDN
                Else
                    If OUprincipale = "OU=GIE-GROUPE2" Then
                        NbAdresse = 2
                        lstadresses.Items.Add(Mid(prenom, 1, 1) & "." & nom & "@GROUPE2.fr")
                        TblMail(1) = "SMTP:" & Mid(prenom, 1, 1) & "." & nom & "@GROUPE2.fr"
                        lstadresses.Items.Add(username & "@" & FQDN)
                        TblMail(NbAdresse) = "smtp:" & username & "@" & FQDN
                    Else
                        MsgBox("Aresses externe non configurées pour ce groupe", 16, "Attention !")
                        PasDeMail = True
                    End If
                End If
            End If
        Else
            NbAdresse = 1
            lstadresses.Items.Add(username & "@" & FQDN)
            TblMail(NbAdresse) = "SMTP:" & username & "@" & FQDN
            Mailexterne = False
        End If
 
        ReDim Preserve TblMail(NbAdresse)
 
    End Function
 
 
    Private Sub btncreer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btncreer.Click
        btncreer.Enabled = False
        'Création de l'utilisateur
        CreateUserAccount()
        'On affiche et initialise la form pour l'envoi de mail
        Module1.form2.Show()
        Module1.form2.initmail()
        Me.Hide()
    End Sub
 
 
 
End Class
Form2.vb
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
 
Public Class Mail
    Inherits System.Windows.Forms.Form
 
#Region " Code généré par le Concepteur Windows Form "
 
    Public Sub New()
        MyBase.New()
 
        'Cet appel est requis par le Concepteur Windows Form.
        InitializeComponent()
 
        'Ajoutez une initialisation quelconque après l'appel InitializeComponent()
 
    End Sub
 
    'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub
 
    'Requis par le Concepteur Windows Form
    Private components As System.ComponentModel.IContainer
 
    'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
    'Elle peut être modifiée en utilisant le Concepteur Windows Form.  
    'Ne la modifiez pas en utilisant l'éditeur de code.
    Friend WithEvents lblde As System.Windows.Forms.Label
    Friend WithEvents TxtDe As System.Windows.Forms.TextBox
    Friend WithEvents TxtPour As System.Windows.Forms.TextBox
    Friend WithEvents TxtCC As System.Windows.Forms.TextBox
    Friend WithEvents RTxtContenu As System.Windows.Forms.RichTextBox
    Friend WithEvents BtnEnvoyer As System.Windows.Forms.Button
    Friend WithEvents TxtSujet As System.Windows.Forms.TextBox
    Friend WithEvents LblSujet As System.Windows.Forms.Label
    Friend WithEvents BtnNouvelle As System.Windows.Forms.Button
    Friend WithEvents BtnQuit As System.Windows.Forms.Button
    Friend WithEvents LblPour As System.Windows.Forms.Label
    Friend WithEvents LblCC As System.Windows.Forms.Label
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Mail))
        Me.lblde = New System.Windows.Forms.Label()
        Me.LblPour = New System.Windows.Forms.Label()
        Me.LblCC = New System.Windows.Forms.Label()
        Me.TxtDe = New System.Windows.Forms.TextBox()
        Me.TxtPour = New System.Windows.Forms.TextBox()
        Me.TxtCC = New System.Windows.Forms.TextBox()
        Me.RTxtContenu = New System.Windows.Forms.RichTextBox()
        Me.BtnEnvoyer = New System.Windows.Forms.Button()
        Me.TxtSujet = New System.Windows.Forms.TextBox()
        Me.LblSujet = New System.Windows.Forms.Label()
        Me.BtnNouvelle = New System.Windows.Forms.Button()
        Me.BtnQuit = New System.Windows.Forms.Button()
        Me.SuspendLayout()
        '
        'lblde
        '
        Me.lblde.Location = New System.Drawing.Point(8, 16)
        Me.lblde.Name = "lblde"
        Me.lblde.Size = New System.Drawing.Size(48, 16)
        Me.lblde.TabIndex = 0
        Me.lblde.Text = "De"
        '
        'LblPour
        '
        Me.LblPour.Location = New System.Drawing.Point(8, 48)
        Me.LblPour.Name = "LblPour"
        Me.LblPour.Size = New System.Drawing.Size(48, 16)
        Me.LblPour.TabIndex = 1
        Me.LblPour.Text = "Pour"
        '
        'LblCC
        '
        Me.LblCC.Location = New System.Drawing.Point(8, 80)
        Me.LblCC.Name = "LblCC"
        Me.LblCC.Size = New System.Drawing.Size(48, 16)
        Me.LblCC.TabIndex = 2
        Me.LblCC.Text = "CC"
        '
        'TxtDe
        '
        Me.TxtDe.Location = New System.Drawing.Point(80, 16)
        Me.TxtDe.Name = "TxtDe"
        Me.TxtDe.Size = New System.Drawing.Size(264, 20)
        Me.TxtDe.TabIndex = 3
        Me.TxtDe.Text = "test@pipo.fr"
        '
        'TxtPour
        '
        Me.TxtPour.Location = New System.Drawing.Point(80, 48)
        Me.TxtPour.Name = "TxtPour"
        Me.TxtPour.Size = New System.Drawing.Size(264, 20)
        Me.TxtPour.TabIndex = 4
        Me.TxtPour.Text = "Administrateur@pipo.fr"
        '
        'TxtCC
        '
        Me.TxtCC.Location = New System.Drawing.Point(80, 80)
        Me.TxtCC.Name = "TxtCC"
        Me.TxtCC.Size = New System.Drawing.Size(264, 20)
        Me.TxtCC.TabIndex = 5
        Me.TxtCC.Text = ""
        '
        'RTxtContenu
        '
        Me.RTxtContenu.Location = New System.Drawing.Point(40, 144)
        Me.RTxtContenu.Name = "RTxtContenu"
        Me.RTxtContenu.Size = New System.Drawing.Size(368, 216)
        Me.RTxtContenu.TabIndex = 6
        Me.RTxtContenu.Text = ""
        '
        'BtnEnvoyer
        '
        Me.BtnEnvoyer.Location = New System.Drawing.Point(48, 384)
        Me.BtnEnvoyer.Name = "BtnEnvoyer"
        Me.BtnEnvoyer.Size = New System.Drawing.Size(104, 40)
        Me.BtnEnvoyer.TabIndex = 7
        Me.BtnEnvoyer.Text = "Envoyer"
        '
        'TxtSujet
        '
        Me.TxtSujet.Location = New System.Drawing.Point(80, 112)
        Me.TxtSujet.Name = "TxtSujet"
        Me.TxtSujet.Size = New System.Drawing.Size(296, 20)
        Me.TxtSujet.TabIndex = 8
        Me.TxtSujet.Text = "Re : demande de création d'utilisateur"
        '
        'LblSujet
        '
        Me.LblSujet.Location = New System.Drawing.Point(8, 112)
        Me.LblSujet.Name = "LblSujet"
        Me.LblSujet.Size = New System.Drawing.Size(56, 16)
        Me.LblSujet.TabIndex = 9
        Me.LblSujet.Text = "Sujet :"
        '
        'BtnNouvelle
        '
        Me.BtnNouvelle.Location = New System.Drawing.Point(176, 384)
        Me.BtnNouvelle.Name = "BtnNouvelle"
        Me.BtnNouvelle.Size = New System.Drawing.Size(96, 40)
        Me.BtnNouvelle.TabIndex = 10
        Me.BtnNouvelle.Text = "Nouvelle création"
        '
        'BtnQuit
        '
        Me.BtnQuit.Location = New System.Drawing.Point(312, 384)
        Me.BtnQuit.Name = "BtnQuit"
        Me.BtnQuit.Size = New System.Drawing.Size(96, 40)
        Me.BtnQuit.TabIndex = 11
        Me.BtnQuit.Text = "Quitter"
        '
        'Mail
        '
        Me.AccessibleName = "Fom2"
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(456, 445)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.BtnQuit, Me.BtnNouvelle, Me.LblSujet, Me.TxtSujet, Me.BtnEnvoyer, Me.RTxtContenu, Me.TxtCC, Me.TxtPour, Me.TxtDe, Me.LblCC, Me.LblPour, Me.lblde})
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Name = "Mail"
        Me.Text = "Mail"
        Me.ResumeLayout(False)
 
    End Sub
 
#End Region
 
    Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
    End Sub
    Public Function initmail()
        'Permet d'initialiser les textbox une fois l'utilisateur créé
        RTxtContenu.Text = "Nouvel utilisateur créé pour " & nomDetaille & " : " & Microsoft.VisualBasic.ControlChars.CrLf & username & Microsoft.VisualBasic.ControlChars.CrLf
        RTxtContenu.Text = RTxtContenu.Text & "Mot de passe : " & Mdp & Microsoft.VisualBasic.ControlChars.CrLf
        If PasDeMail = True Then
            RTxtContenu.Text = RTxtContenu.Text & Microsoft.VisualBasic.ControlChars.CrLf & "Pas de messagerie"
        Else
            RTxtContenu.Text = RTxtContenu.Text & Microsoft.VisualBasic.ControlChars.CrLf & "Adresse principale de messagerie : " & Microsoft.VisualBasic.ControlChars.CrLf & Mid(TblMail(1), 6)
        End If
        If Office Then
            RTxtContenu.Text = RTxtContenu.Text & Microsoft.VisualBasic.ControlChars.CrLf & Microsoft.VisualBasic.ControlChars.CrLf & "Accès à Office"
        Else
            RTxtContenu.Text = RTxtContenu.Text & Microsoft.VisualBasic.ControlChars.CrLf & Microsoft.VisualBasic.ControlChars.CrLf & "Pas d'accès à Office"
        End If
        RTxtContenu.Text = RTxtContenu.Text & Microsoft.VisualBasic.ControlChars.CrLf & Microsoft.VisualBasic.ControlChars.CrLf & Microsoft.VisualBasic.ControlChars.CrLf & "Cordialement," & Microsoft.VisualBasic.ControlChars.CrLf & "L'exploitation."
    End Function
 
    Private Sub BtnEnvoyer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnEnvoyer.Click
        'Envoie le message
        Dim MyMessage As New System.Web.Mail.MailMessage()
 
        BtnEnvoyer.Enabled = False
        MyMessage.From = TxtDe.Text
        MyMessage.To = TxtPour.Text
        MyMessage.Subject = TxtSujet.Text
        MyMessage.Cc = TxtCC.Text
        MyMessage.Body = RTxtContenu.Text
        System.Web.Mail.SmtpMail.SmtpServer = EXCHServer
        System.Web.Mail.SmtpMail.Send(MyMessage)
 
        If Err.Number <> 0 Then
            MsgBox(Err.Description, 16, "Erreur")
        End If
        BtnEnvoyer.Enabled = True
 
    End Sub
 
    Private Sub BtnQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnQuit.Click
        End
    End Sub
 
    Private Sub BtnNouvelle_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnNouvelle.Click
        Module1.form2.Close()
        Module1.form1 = New Form1()
        Module1.form1.Show()
    End Sub
End Class
Module1.vb
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
 
Module Module1
 
    'Pour AD
    Public Site As String
    Public DomainName As String
    Public FQDN As String
    Public DomaineNetbios As String
    Public DCServer As String
    Public OUprincipale As String
    Public OUutilisateur As String
    Public username As String
    Public nom As String
    Public nomDetaille As String
    Public prenom As String
    Public Mdp As String
    Public User As Object
    Public UserDN As String
    Public Office As Boolean
    Public FichierOffice As String
    Public CheminRessources As String
    Public Mailexterne As Boolean
    Public TblMail(3) As Object
    Public NbAdresse As Integer
    Public PasDeMail As Boolean
    Public SRVUserRess As String
    Public MailContenu As String
    Public form2 As Mail
    Public form1 As Form1
 
 
    'Pour Exchange
    Public EXCHServer As String
    Public OrganisationExchange As String
    Public CheminADExchange As String
 
    Public Function VerifString(ByVal MaChaine)
        MaChaine = Replace(MaChaine, "é", "e")
        MaChaine = Replace(MaChaine, "è", "e")
        MaChaine = Replace(MaChaine, "ê", "e")
        MaChaine = Replace(MaChaine, "à", "a")
        MaChaine = Replace(MaChaine, "â", "a")
        MaChaine = Replace(MaChaine, "ô", "o")
        MaChaine = Replace(MaChaine, "ù", "u")
        MaChaine = Replace(MaChaine, "û", "u")
        MaChaine = Replace(MaChaine, "î", "i")
        VerifString = MaChaine
    End Function
 
    Public Function VerifEspace(ByVal MaChaine)
        MaChaine = Replace(MaChaine, " ", "")
        MaChaine = Replace(MaChaine, "-", "")
        VerifEspace = MaChaine
    End Function
 
    Public Function FindUser()
        'Fonction de recherche de l'utilisateur
        'Renvoie du texte
 
        Dim cn
        Dim cmd
        Dim rs
 
        On Error Resume Next
        Err.Clear()
 
        cn = CreateObject("ADODB.Connection")
        cmd = CreateObject("ADODB.Command")
        rs = CreateObject("ADODB.Recordset")
 
        cn.open("Provider=ADsDSOObject;")
 
        cmd.activeconnection = cn
        cmd.commandtext = "SELECT ADsPath FROM 'LDAP://" & DomainName & "' WHERE sAMAccountName = '" & username & "'"
 
        rs = cmd.execute
 
        If Err.Number <> 0 Then
            Return "Error connecting to Active Directory Database:" & Err.Description
        Else
            If Not rs.BOF And Not rs.EOF Then
                rs.MoveFirst()
                Return "Trouve"
            Else
                Return "Not Found"
            End If
        End If
        cn.close()
    End Function
    Public Function CreateUserAccount()
 
        Dim objcontainer
 
        UserDN = "LDAP://cn=" & username & "," & OUutilisateur & "," & OUprincipale & "," & DomainName
 
        'Conteneur
        objcontainer = GetObject("LDAP://" & OUutilisateur & "," & OUprincipale & "," & DomainName)
 
        'création de l'objet utilisateur
        User = objcontainer.Create("user", "cn=" & username)
 
        'le sAMAccountName est le nom d'ouverture de session
        User.SAMAccountName = username
 
        'Sauvegarde
        User.Setinfo()
 
        'Remplissage des cases
        If Err.Number <> 0 Then
            MsgBox("probleme dans la création")
        Else
            User.userPrincipalName = username & "@" & FQDN
            User.sn = nom
            User.givenName = prenom
            User.displayName = nomDetaille
            User.SetPassword(Mdp)
            User.AccountDisabled = False
            User.SetInfo()
            'On renseigne le Profile de services TSE
            Dim obj
            obj = CreateObject("wts_admin.functions")   'accessible after registering wts_admin.dll
 
            Dim retval 'integer
            Dim profilepath  'string
            Dim bLogin 'boolean
 
            ' * * *          set user's profile path
            profilepath = "\\" & DCServer & "\Profiles$\" & username 'new directory to change user's homedirectory to.
            retval = obj.settsprofilepath(DCServer, username, profilepath)
 
            ' * * *          set whether user is allowed to login to terminal server
            bLogin = True 'boolean value
            retval = obj.SetTSConfigfAllowLogonTerminalServer(DCServer, username, bLogin)
        End If
 
        If OUprincipale = "OU=GROUPE1" Then
            addToGroup("LDAP://CN=GROUPE1_UTILISATEURS,OU=GROUPES GROUPE1," & OUprincipale & "," & DomainName)
        End If
        If OUprincipale = "OU=GROUPE3" Then
            addToGroup("LDAP://CN=GROUPE3_Utilisateurs," & OUprincipale & "," & DomainName)
        End If
        If OUprincipale = "OU=GIE-GROUPE2" Then
            addToGroup("LDAP://CN=GIE-GROUPE2_Utilisateur," & OUprincipale & "," & DomainName)
        End If
        If Not PasDeMail Then
            CreateMailBox()
        End If
        If Office Then
            PutOffice()
        End If
 
 
    End Function
 
    Public Function addToGroup(ByVal groupDN)
        Dim objGroup
        Dim member
        objGroup = GetObject(groupDN)
        For Each member In objGroup.members
            If LCase(member.adspath) = LCase(UserDN) Then
                Exit Function
            End If
        Next
        objGroup.Add(UserDN)
 
    End Function
 
    Public Function CreateMailBox()
 
 
        Dim AdrInt
        Dim objmailbox
        Dim User
        Dim MailName
        Dim i
        Dim Mail
 
        User = GetObject("LDAP://CN=" & username & "," & OUutilisateur & "," & OUprincipale & "," & DomainName)
        'On parametre ici l'adresse e-mail
        If OUprincipale = "OU=GROUPE1" Then
            MailName = nom
        Else
            MailName = username
        End If
        AdrInt = MailName & "@" & FQDN
 
 
        ' On passe à la création de la boite aux lettres 
 
 
        objmailbox = CreateObject("CDO.Person").getinterface("IMailboxStore")
        objmailbox = User
        objmailbox.CreateMailBox(CheminADExchange)
        objmailbox.ProxyAddresses = TblMail
        objmailbox.SetInfo()
        If Err.Number <> 0 Then
            MsgBox("probleme dans la configuration de la boite aux lettres")
        Else
            User.mailNickname = MailName
            User.SetInfo()
            If Err.Number <> 0 Then
                MsgBox("probleme dans la configuration de la boite aux lettres")
            End If
        End If
 
    End Function
    Public Function PutOffice()
 
        Dim objshell
        Dim Fso
        FichierOffice = CheminRessources & "\" & username
        Fso = CreateObject("Scripting.FileSystemObject")
        objshell = CreateObject("Wscript.Shell")
 
        If Not Fso.FolderExists(FichierOffice) Then
            Fso.CreateFolder(FichierOffice)
        Else
            MsgBox("Fichier de ressources Office déja créé", 16, "Attention !")
        End If
        If Err.Number <> 0 Then
            MsgBox("probleme dans la création du repertoire Office " & FichierOffice)
        Else
            addToGroup("LDAP://CN=Microsoft OFFICE 2000,OU=GROUPES APPLICATIONS," & DomainName)
 
            objshell.Run("%COMSPEC% /c Echo o| cacls " & FichierOffice & " /G " & Chr(34) & "Admins du domaine" & Chr(34) & ":F " & username & ":C" & " SYSTEM:C >NUL")
 
        End If
 
    End Function
 
 
End Module

Merci de l'aide pour me permettre de faire un bouton recommencer et quitter

@+