Script VBS: mappage réseaux selon les groupes de l'utilisateur de AD

Version imprimable

Bonjours a tous.

Je tien à dire que je ne suis pas programmeur, je me suis largement inspirer de ce que j’ai trouvé sur le net. Et je l’ai ensuite adapté à mes besoins.

Le but du Script est de mapper les lecteurs réseaux selon les groupes auquel appartiennent les utilisateurs de l’Active Directory lors de l’ouverture de session. Je suis sous Windows 2003 serveur.

Mon problème est lors que les utilisateurs sont membre de plusieurs groupes dans l’AD. Le script ne prend en compte qu’un seul de ces groupes et donc ne connecte pas tous les lecteurs réseaux dont ils ont besoins.

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
77
78
79
80
81
82
83
Dim objRootLDAP, objGroup, objUser, objOU, objmemberOf
Dim strOU, strUser, strDNSDomain, strLDAP, List, objADSysInfo,arr,intlength,intNamelength,strGroupName
Dim strDrive,strShare,strServer,strArts,strCine,strComm,strComp,strDire,strDocu,strLitt,strSpec
 
 
BS = Chr(92) ' Backslash
DBS = BS & BS ' Double Backslash
strServer="srv" 'Nom du serveur
strArts="Arts plastiques" 'Nom du partage d'échange du groupe Arts plastiques
strCine="Cinema" 'Nom du partage d'échange du groupe Cinema
strComm="Communication" 'Nom du partage d'échange du groupe Communication
strComp="Comptabilite" 'Nom du partage d'échange du groupe Comptabilite
strDire="Direction" 'Nom du partage d'échange du groupe Direction
strDocu="Documentation" 'Nom du partage d'échange du groupe Documentation
strLitt="Litterature" 'Nom du partage d'échange du groupe Litterature
strSpec="Spectacles" 'Nom du partage d'échange du groupe Spectacles
 
 
' Commands to bind to AD
Set objRootLDAP = GetObject("LDAP://RootDSE")
Set objNetwork = CreateObject("Wscript.Network" )
 
 
'Trouver le DN de l'utilisateur
Set objADSysInfo = CreateObject("ADSystemInfo" )
strUser = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
 
' Extraire la liste des groupes de l'utilisateur
objmemberOf  = objUser.GetEx("memberOf" )
For Each objGroup in objmemberOf
     List = List & objGroup & vbCr
      arr=Split(List,"," )
      intlength=Len(arr(0))
      intNamelength=intlength - 3
Next
strGroupName= Right(arr(0), intNameLength)
WScript.Echo strGroupName
WScript.Echo strUser
 
 
'tableau contenant lecteurs et partages par groupes'
Select Case strGroupName
   Case "Cinema"
           aryShares = Array(Array("O:",DBS & strServer & BS & strCine))        
   Case "Comptabilite"
           aryShares = Array(Array("P:",DBS & strServer & BS & strComp))
   Case "Spectacles"
           aryShares = Array(Array("N:",DBS & strServer & BS & strSpec))
   Case "Litterature"
           aryShares = Array(Array("M:",DBS & strServer & BS & strLitt))
   Case "Documentation"
           aryShares = Array(Array("L:",DBS & strServer & BS & strDocu))
   Case "Communication"
           aryShares = Array(Array("R:",DBS & strServer & BS & strComm))
   Case "Arts plastiques"
           aryShares = Array(Array("Q:",DBS & strServer & BS & strArts))
   Case "Direction"
           aryShares = Array(Array("S:",DBS & strServer & BS & strDire),_
                             Array("O:",DBS & strServer & BS & strCine),_
                             Array("P:",DBS & strServer & BS & strComp),_
                             Array("N:",DBS & strServer & BS & strSpec),_
                             Array("M:",DBS & strServer & BS & strLitt),_
                             Array("L:",DBS & strServer & BS & strDocu),_
                             Array("R:",DBS & strServer & BS & strComm),_
                             Array("Q:",DBS & strServer & BS & strArts))
End Select
 
 
'Procédure mappage d'un lecteur 
Sub Mappage(strDrive,strShare)
      objNetwork.MapNetworkDrive strDrive, strShare
End Sub
 
 
'Mapper les lecteurs
For i = LBound(aryShares) to UBound(aryShares)
   aryAux = aryShares(i)
   Mappage aryAux(0), aryAux(1)
Next
 
WScript.Quit

Comme je l’ai dit plus haut la programmation n’est pas mon domaine de prédilection, je sollicite donc votre aide à tous. :hola:Oh programmeurs!:hola:

:D merci d'avance

Salut,

devant le peu de réponses à ton post, je me lance...
1/ Tu crées un tableau "arr" mais tu prends toujours la 1ere valeur de ce tableau :

Code:

strGroupName= Right(arr(0), intNameLength)

Donc ton WScript.Echo strGroupName te retourne toujours la même valeur...

2/ Ensuite dans ta boucle, 'Mapper les lecteurs', tu fais exactement la même erreur, tu ne lis à chaque fois que la 1ere valeur et la seconde valeur de ton tableau :

Code:

Mappage aryAux(0), aryAux(1)

En admettant que ton tableau arr soit correct, il te faut faire une boucle du début jusqu'à la fin de ton tableau ou chaque ligne représente le nom du groupe de ton AD.

En admettant que ton tableau aryAux soit correct, il te faut faire une boucle du début jusqu'à la fin de ton tableau ou chaque ligne représente le mappage à effectuer.

Donc pour faire + simple, je supprime les tableaux et les subs et je mets en dur les mappages à effectuer dans chaque ligne 'case'.
Voici donc le code que je te propose :

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
 
Dim objRootLDAP, objGroup, objUser, objOU, objmemberOf
Dim strOU, strUser, strDNSDomain, strLDAP, List, objADSysInfo,arr,intlength,intNamelength,strGroupName
Dim strDrive,strShare,strServer,strArts,strCine,strComm,strComp,strDire,strDocu,strLitt,strSpec
 
 
BS = Chr(92) ' Backslash
DBS = BS & BS ' Double Backslash
strServer="srv" 'Nom du serveur
strArts="Arts plastiques" 'Nom du partage d'échange du groupe Arts plastiques
strCine="Cinema" 'Nom du partage d'échange du groupe Cinema
strComm="Communication" 'Nom du partage d'échange du groupe Communication
strComp="Comptabilite" 'Nom du partage d'échange du groupe Comptabilite
strDire="Direction" 'Nom du partage d'échange du groupe Direction
strDocu="Documentation" 'Nom du partage d'échange du groupe Documentation
strLitt="Litterature" 'Nom du partage d'échange du groupe Litterature
strSpec="Spectacles" 'Nom du partage d'échange du groupe Spectacles
 
 
' Commands to bind to AD
Set objRootLDAP = GetObject("LDAP://RootDSE")
Set objNetwork = CreateObject("Wscript.Network" )
 
 
'Trouver le DN de l'utilisateur
Set objADSysInfo = CreateObject("ADSystemInfo" )
strUser = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
WScript.Echo strUser 
 
' Extraire la liste des groupes de l'utilisateur
objmemberOf  = objUser.GetEx("memberOf" )
For Each objGroup in objmemberOf
     strGroupName = objGroup
     intNamelength=en(strGroupName) - 3
     strGroupName= Right(strGroupName, intNameLength)
     WScript.Echo strGroupName
 
    'tableau contenant lecteurs et partages par groupes'
     Select Case strGroupName
           Case "Cinema"
           objNetwork.MapNetworkDrive "O:",DBS & strServer & BS & strCine
           Case "Comptabilite"
           objNetwork.MapNetworkDrive "P:",DBS & strServer & BS & strComp
           Case "Spectacles"
           objNetwork.MapNetworkDrive "N:",DBS & strServer & BS & strSpec
           Case "Litterature"
           objNetwork.MapNetworkDrive "M:",DBS & strServer & BS & strLitt
           Case "Documentation"
           objNetwork.MapNetworkDrive "L:",DBS & strServer & BS & strDocu
           Case "Communication"
           objNetwork.MapNetworkDrive "R:",DBS & strServer & BS & strComm
           Case "Arts plastiques"
           objNetwork.MapNetworkDrive "Q:",DBS & strServer & BS & strArts
           Case "Direction"
           objNetwork.MapNetworkDrive "S:",DBS & strServer & BS & strDire
           objNetwork.MapNetworkDrive "O:",DBS & strServer & BS & strCine
           objNetwork.MapNetworkDrive "P:",DBS & strServer & BS & StrComp
           objNetwork.MapNetworkDrive "N:",DBS & strServer & BS & strSpec
           objNetwork.MapNetworkDrive "M:",DBS & strServer & BS & strLitt
           objNetwork.MapNetworkDrive "L:",DBS & strServer & BS & strDocu
           objNetwork.MapNetworkDrive "R:",DBS & strServer & BS & strComm
           objNetwork.MapNetworkDrive "Q:",DBS & strServer & BS & strArts
     End Select
Next 
 
WScript.Quit

Voilà, je pense que déjà avec ca on ne devrait pas etre bien loin du but et que tu devrais avoir de quoi faire de nouveaux tests.

A++

Salut,

Je te remercie beaucoup de t'être penché sur mon prb.
Grâce à ton aide ça tourne parfaitement.

Juste une petite précision comme j'ai un peut galère avant de trouver, dans le "case" il faut que la comparaison se fasse le nom complet du "strGroupName" soit pour ex:"Cinema,OU=Groupes CWB,DC=CWB,DC=local"

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
Dim objRootLDAP, objGroup, objUser, objOU, objmemberOf
Dim strOU, strUser, strDNSDomain, strLDAP, List, objADSysInfo,arr,intlength,intNamelength,strGroupName
Dim strDrive,strShare,strServer,strArts,strCine,strComm,strComp,strDire,strDocu,strLitt
,strSpec
 
 
BS = Chr(92) ' Backslash
DBS = BS & BS ' Double Backslash
strServer="srv" 'Nom du serveur
strArts="Arts plastiques" 'Nom du partage d'échange du groupe Arts plastiques
strCine="Cinema" 'Nom du partage d'échange du groupe Cinema
strComm="Communication" 'Nom du partage d'échange du groupe Communication
strComp="Comptabilite" 'Nom du partage d'échange du groupe Comptabilite
strDire="Direction" 'Nom du partage d'échange du groupe Direction
strDocu="Documentation" 'Nom du partage d'échange du groupe Documentation
strLitt="Litterature" 'Nom du partage d'échange du groupe Litterature
strSpec="Spectacles" 'Nom du partage d'échange du groupe Spectacles
 
 
' Commands to bind to AD
Set objRootLDAP = GetObject("LDAP://RootDSE")
Set objNetwork = CreateObject("Wscript.Network" )
 
 
'Trouver le DN de l'utilisateur
Set objADSysInfo = CreateObject("ADSystemInfo" )
strUser = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
'WScript.Echo strUser
 
' Extraire la liste des groupes de l'utilisateur
objmemberOf  = objUser.GetEx("memberOf" )
For Each objGroup in objmemberOf
     strGroupName = objGroup
     intNamelength=Len(strGroupName) - 3
     strGroupName= Right(strGroupName, intNameLength)
'WScript.Echo strGroupName
 
    'tableau contenant lecteurs et partages par groupes
     Select Case strGroupName
           Case "Cinema,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "O:",DBS & strServer & BS & strCine
           Case "Comptabilite,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "P:",DBS & strServer & BS & strComp
           Case "Spectacles,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "N:",DBS & strServer & BS & strSpec
           Case "Litterature,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "M:",DBS & strServer & BS & strLitt
           Case "Documentation,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "L:",DBS & strServer & BS & strDocu
           Case "Communication,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "R:",DBS & strServer & BS & strComm
           Case "Arts plastiques,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "Q:",DBS & strServer & BS & strArts
           Case "Direction,OU=Groupes CWB,DC=CWB,DC=local"
           objNetwork.MapNetworkDrive "S:",DBS & strServer & BS & strDire
           objNetwork.MapNetworkDrive "O:",DBS & strServer & BS & strCine
           objNetwork.MapNetworkDrive "P:",DBS & strServer & BS & StrComp
           objNetwork.MapNetworkDrive "N:",DBS & strServer & BS & strSpec
           objNetwork.MapNetworkDrive "M:",DBS & strServer & BS & strLitt
           objNetwork.MapNetworkDrive "L:",DBS & strServer & BS & strDocu
           objNetwork.MapNetworkDrive "R:",DBS & strServer & BS & strComm
           objNetwork.MapNetworkDrive "Q:",DBS & strServer & BS & strArts
     End Select
Next 
 
WScript.Quit

Encore un grand merci à toi RadPat:lahola: