List Users OWA,VPN

Version imprimable

17/09/2008, 15h22
fabrice518

List Users OWA,VPN

Bonjour,

je cherche a interroger mon AD dans un language type VBs parce que je n'ai pas d'outils de developpement donc ca me semblait le plus simple.

Je souhaite creer un tableau avec la liste des mes utilisateurs et savoir s'ils ont les fonctionnalités OWA, OMA, DirectPush (Synchro initié par l'utilisateur) , VPN (autorisation d'acces distant), Option de remise:adresse de transfert.

Mon probleme, c'est que je ne connais pas le language (pas de probleme pour apprendre meme si c'est urgent !), et que je ne connais le nom des attributs a interroger.

Si quelqu'un a un bout de code sous le coude, je suis preneur !

Merci d'avance.
Fabrice

AD, OWA VPN

Bonjour,
j'ai commencé un peu de code, mais j'ai plusieurs questions :
1. Comment bien gerer des champs vides, j'ai vu IsEmpty(), mais comment l'optimiser dans mon code ?
2. J'ai des erreurs lorsque je recupere si OWA est activé.

Voila mon code, merci pour le coup de pouce !

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
84
85
86
87
88
89
90
91
92
93
94
95
'Connexion a l'AD
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = 2
 
'Definition de la requete : 
strSelect = "Name, Description, mail, msExchOmaAdminWirelessEnable, protocolSettings, altRecipient, msNPAllowDialin"
strFrom = "'LDAP://ou=utilisateurs,dc=MyDomain,dc=local'"
strWhere = "objectClass='user'"
objCommand.CommandText = "SELECT " & strSelect & " FROM " & strFrom & " WHERE " & strWhere
 
'Création d'un recordset d'après la requete
Set objRecordSet = objCommand.Execute
 
'Si le recordset contient des enregistrements, alors...
If objRecordSet.RecordCount > 0 Then
 
	'On se déplace sur la ligne 2 pour eviter les entetes
	objRecordSet.MoveFirst
	objRecordSet.MoveNext
 
	' on inscrit les enregistrement dans des variables: Nom, description, mail
	usrName = objRecordSet.Fields("Name").Value
	usrDescript = objRecordSet.Fields("Description").Value
	usrMail = objRecordSet.Fields("mail").Value
	'Fonctionnalité Exchange, Services mobiles
	usrMobile = MobileConvert(objRecordSet.Fields("msExchOmaAdminWirelessEnable").Value)
	'Fonctionnalité Exchange, Protocol. Petite fonction pour tester OWA -> usrProtocol
	'DescList = objRecordSet.Fields("protocolSettings").Value
	Desc = objRecordSet.Fields("protocolSettings").Value
	'For Each Desc In DescList
		i = InStr(1, Desc, "§", vbTextCompare)
		If Left(Desc, i - 1) = "HTTP" Then
			Desc = Right(Desc, Len(Desc) - i)
				If Left(Desc, 1) = "1" Then
					usrProtocol = "Activé"
				Else
					usrProtocol = ""
				End If
		End If
	'Next
	'Exchange, Option de Remise, Adresse de transfert
	If IsEmpty(objRecordSet.Fields("altRecipient").Value) = False Then
		usrFoward = ""
	Else
		usrFoward = objRecordSet.Fields("altRecipient").Value
	End If
	'Appel entrant, Autorisation d'acces distant
	usrVPN = VPNconvert(objRecordSet.Fields("msNPAllowDialin").Value)
 
 
Else 
	'Aucun enregistrement
	msgbox "La requete a renvoyée aucune donnée."
End If
 
msgbox usrname & usrmail & usrmobile & usrVPN & usrFoward
 
'_________________________________________________________
'Convertion de la valeur en  texte
Function VPNconvert(VPN)
 
	If VPN = "Vrai" Then
		VPNconvert = "Autorisé"
	ElseIf VPN = "Faux" Then
		VPNconvert = "Refusé"
	Else VPNconvert = "Selon stratégie"
	End If
 
End Function
 
'_________________________________________________________
'Convertion de la valeur décimale en donnée texte
Function MobileConvert(Mobile)
 
	If Mobile = 0 Then
		MobileConvert = "OMA, Active Sync, DirectPush"
	ElseIf Mobile = 1 Then
		MobileConvert = "OMA, Active Sync"
	ElseIf Mobile = 2 Then
		MobileConvert = "Active Sync, DirectPush"
	ElseIf Mobile = 3 Then
		MobileConvert = "Active Sync"
	ElseIf Mobile = 5 Then
		MobileConvert = "OMA"
	ElseIf Mobile = 7 Then
		MobileConvert = "Aucun accès"
	Else MobileConvert = "Introuvable"
	End If
End Function

Citation:

1. Comment bien gerer des champs vides, j'ai vu IsEmpty(), mais comment l'optimiser dans mon code ?

Tu te trompes sur le but de IsEmpty.
Cette fonction sert à savoir si une variable a été initialisé.
En fait plus précisément, elle cherche à savoir si une variable à la valeur Empty, qui est attribué automatiquement par l'interpréteur VBS à une variable avant son initialisation.

Exemple :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Dim test If IsEmpty(test) Then wscript.echo "test est Empty, on l'initialise avec un nombre." test = 2 'De ce fait, test qui était non typée jusqu'ici devient un int 'et est initialisé à 2. End If 'Le Not permet de négationner un test. 'Ici IsEmpty renvois False, donc avec Not cela devient True et l'on rentre dans le If. 'Sans le Not on serait rentré dans un Else s'il était présent. If Not IsEmpty(test) Then wscript.echo "test est initialisté, il n'est donc plus Empty." End If
Pour le reste, ce n'est pas mon domaine de compétence l'AD, alors il faudra attendre que quelqu'un d'autre intervienne.

Mais n'hésite pas à poster tes nouvelles version du script, je pourrais toujours voir les erreurs de syntaxe perso ;)

Edit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 '_________________________________________________________ 'Convertion de la valeur décimale en donnée texte Function MobileConvert(Mobile) If Mobile = 0 Then MobileConvert = "OMA, Active Sync, DirectPush" ElseIf Mobile = 1 Then MobileConvert = "OMA, Active Sync" ElseIf Mobile = 2 Then MobileConvert = "Active Sync, DirectPush" ElseIf Mobile = 3 Then MobileConvert = "Active Sync" ElseIf Mobile = 5 Then MobileConvert = "OMA" ElseIf Mobile = 7 Then MobileConvert = "Aucun accès" Else MobileConvert = "Introuvable" End If End Function
J'utilise beaucoup le Else IF aussi, mais dans certain cas il est peut être plus approprié de faire des Select case.
Mais bon ce code est quand même fonctionnelle.

Liste AD, owa, vpn...

Bonjour et merci pour ta réponse,

j'ai modifié le code entre temps :
IsNull à la place d' IsEmpty

A l'heure actuelle, le code fonctionne presque bien et remplit mon fichier texte.
J'ai un petit soucis, c'est l'attribut description qui me genère des erreurs.
Ensuite j'aimerais optimiser ce code, car je ne pense pas l'avoir ecrit de la meilleur facon.
Merci d'avance pour tout les conseils...

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
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
 
	'Connexion a l'AD
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection
 
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = 2
 
	'Definition de la requete : 
	strSelect = "Name, Description, mail, msExchOmaAdminWirelessEnable, protocolSettings, altRecipient, msNPAllowDialin"
	strFrom = "'LDAP://ou=utilisateurs,dc=MyDomain,dc=local'"
	strWhere = "objectClass='user'"
	strOrder = "Name ASC"
	objCommand.CommandText = "SELECT " & strSelect & " FROM " & strFrom & " WHERE " & strWhere & " ORDER BY " & strOrder
 
	'Création d'un recordset d'après la requete
	Set objRecordSet = objCommand.Execute
 
	'Si le recordset contient des enregistrements, alors...
	If objRecordSet.RecordCount > 0 Then
 
		'On se déplace sur la ligne 1ère ligne
		objRecordSet.MoveFirst
 
		'Tester l'existance du fichier avant d'ecrire dedant
		Set FileSys = CreateObject("Scripting.FileSystemObject")
		strFilePath = "c:\ad.txt"
		If FileSys.FileExists (strFilePath) then
			Msgbox "Le fichier existe, supprimer le et relancer le script."
		Else
			'Il n'existe pas, alors on le crée
			Set MonFic = FileSys.CreateTextFile(strFilePath)
			'On inscrit l'entete des colonnes
			MonFic.writeLine "Nom;Description;Mail;Mobile;VPN;Transfert mail;OWA;"
			'On le replit
			While Not objRecordSet.EOF
				'La focntion usrVar sert a mettre les données usr*** en forme
				Call usrVar
				'On ecrit dans le fichier
				With MonFic
					.writeLine usrname & usrDescript & usrmail & usrmobile & usrVPN & usrFoward & usrProtocol
				End With
				objRecordSet.MoveNext
			Wend
			objRecordset.Close
			MonFic.Close
			msgbox "Le fichier est créé dans " & strFilePath
		End if
 
	Else 
		'Aucun enregistrement
		msgbox "La requete a renvoyée aucune donnée."
	End If
 
 
'_________________________________________________________
'Convertion des valeurs en  texte
Function usrVar
	' on inscrit les enregistrement non Null dans des variables...
	'Nom
	If IsNull(objRecordSet.Fields("Name").Value) = True Then
		usrName = ";"
	Else usrName = objRecordSet.Fields("Name").Value & ";"
	End If
 
	'Description
	If IsNull(objRecordSet.Fields("Description").Value) = True Then
		usrDescript = ";"
	Else usrDescript = ";"'objRecordSet.Fields("Description").Value & ";"
	End If
 
	'mail
	If IsNull(objRecordSet.Fields("mail").Value) = True Then 
		usrMail = ";"
	Else usrMail = objRecordSet.Fields("mail").Value & ";"
	End If
 
	'Fonctionnalité Exchange, Services mobiles -> usrMobile
	usrMobile = MobileConvert(objRecordSet.Fields("msExchOmaAdminWirelessEnable").Value) & ";"
 
	'Fonctionnalité Exchange, Protocol. Petite fonction pour tester OWA -> usrProtocol
	If IsNull(objRecordSet.Fields("protocolSettings").Value) = True  Then
		usrProtocol = "Activé;"
	Else DescList = objRecordSet.Fields("protocolSettings").Value
		For Each Desc In DescList
			i = InStr(1, Desc, "§", vbTextCompare)
			If Left(Desc, i - 1) = "HTTP" Then
				Desc = Right(Desc, Len(Desc) - i)
				If Left(Desc, 1) = "1" Then
					usrProtocol = "Activé;"
				Else
					usrProtocol = "Désactivé;"
				End If
			End If
		Next
	End If
 
	'Exchange, Option de Remise, Adresse de transfert
	If IsEmpty(objRecordSet.Fields("altRecipient").Value) = False Then
		usrFoward = ";"
	Else
		usrFoward = objRecordSet.Fields("altRecipient").Value & ";"
	End If
	'Appel entrant, Autorisation d'acces distant
	usrVPN = VPNconvert(objRecordSet.Fields("msNPAllowDialin").Value) & ";"
 
End Function			
 
'_________________________________________________________
'Convertion de la valeur en  texte
Function VPNconvert(VPN)
 
	If VPN = "Vrai" Then
		VPNconvert = "Autorisé"
	ElseIf VPN = "Faux" Then
		VPNconvert = "Refusé"
	Else VPNconvert = "Selon stratégie"
	End If
 
End Function
 
'_________________________________________________________
'Convertion de la valeur décimale en donnée texte
Function MobileConvert(Mobile)
 
	Select Case Mobile
		Case 0 MobileConvert = "OMA, Active Sync, DirectPush"
		Case 1 MobileConvert = "OMA, Active Sync"
		Case 2 MobileConvert = "Active Sync, DirectPush"
		Case 3 MobileConvert = "Active Sync"
		Case 5 MobileConvert = "OMA"
		Case 7 MobileConvert = "Aucun accès"
		Case Else MobileConvert = "Introuvable"
	End Select
 
End Function

19/09/2008, 19h13
ced600

Citation:

J'ai un petit soucis, c'est l'attribut description qui me genère des erreurs.

C'est quoi ces erreurs ?

List User AD owa, VPN

Bonjour Ced600,

Lorsque j'essaye de récupérer l'attribut 'Description', j'ai l'erreur suivante :

Ligne : 99
Caract. : 7
Erreur : Type Incompatible
Code : 800A000D

Merci !

Revoila mon code :

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
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
 
 
	'Connexion a l'AD
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand =   CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection
 
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = 2
 
	'Definition de la requete : 
	strSelect = "Name, Description, mail, msExchOmaAdminWirelessEnable, protocolSettings, altRecipient, msNPAllowDialin"
	strFrom = "'LDAP://ou=utilisateurs,dc=itc-ariane,dc=local'"
	strWhere = "objectClass='user'"
	strOrder = "Name ASC"
	objCommand.CommandText = "SELECT " & strSelect & " FROM " & strFrom & " WHERE " & strWhere & " ORDER BY " & strOrder
 
	'Création d'un recordset d'après la requete
	Set objRecordSet = objCommand.Execute
 
	'Si le recordset contient des enregistrements, alors...
	If objRecordSet.RecordCount > 0 Then
 
		'On se déplace sur la ligne 1ère ligne
		objRecordSet.MoveFirst
 
		'Tester l'existance du fichier avant d'ecrire dedant
		strFilePath = EnregistrerSous("Enregistrer le fichier sous...","" )
		strFileName = "ListeUsersFonctions.csv"
		strFilePath = strFilePath & "\" & strFileName
 
		Set FileSys = CreateObject("Scripting.FileSystemObject")
		If FileSys.FileExists (strFilePath) then
			Msgbox "Le fichier existe, supprimer le et relancer le script."
			WScript.Quit
		Else
			'Il n'existe pas, alors on le crée
			Set MonFic = FileSys.CreateTextFile(strFilePath)
			'On inscrit l'entete des colonnes
			MonFic.writeLine "Nom;Description;Mail;Mobilité;VPN;Transfert mail;OWA;"
			'On le replit
			While Not objRecordSet.EOF
				'La focntion usrVar sert a mettre les données usr*** en forme
				Call usrVar
				'On ecrit dans le fichier
				With MonFic
					.writeLine usrname & usrDescript & usrmail & usrmobile & usrVPN & usrForward & usrProtocol
				End With
				objRecordSet.MoveNext
			Wend
			MonFic.Close
			msgbox "Le fichier " & strFileName & VbCrlf &_
				"est créé dans " & Left(strFilePath, Len(strFilePath) - Len(strFileName))
 
		End if
 
	Else 
		'Aucun enregistrement
		msgbox "La requete a renvoyée aucune donnée."
	End If
	objRecordset.Close
'
'_________________________________________________________
Function EnregistrerSous(message,directory)
'Affiche de la boite de dialoque "enregistrer sous..."
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
 
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, message , NO_OPTIONS, directory)
 
On Error Resume Next
Set objFolderItem = objFolder.Self
 
If Err <> 0 Then
	EnregistrerSous = "ANNUL"
	'Quitter la fonction ici
	WScript.Quit 
Else
	EnregistrerSous = objFolderItem.Path
End if
On Error GoTo 0
End Function
 
'_________________________________________________________
'Definition des variables avec les données du Recordset
Function usrVar
	' on inscrit les enregistrement non Null dans des variables...
	'Nom
	If IsNull(objRecordSet.Fields("Name").Value) = True Then
		usrName = ";"
	Else usrName = objRecordSet.Fields("Name").Value & ";"
	End If
 
	'Description
	If IsNull(objRecordSet.Fields("Description").Value) = True Then
		usrDescript = ";"
	Else usrDescript = objRecordSet.Fields("Description").Value & ";"
	End If
 
	'mail
	If IsNull(objRecordSet.Fields("mail").Value) = True Then 
		usrMail = ";"
	Else usrMail = objRecordSet.Fields("mail").Value & ";"
	End If
 
	'Fonctionnalité Exchange, Services mobiles -> usrMobile
	usrMobile = MobileConvert(objRecordSet.Fields("msExchOmaAdminWirelessEnable").Value) & ";"
 
	'Fonctionnalité Exchange, Protocol. Petite fonction pour tester OWA -> usrProtocol
	If IsNull(objRecordSet.Fields("protocolSettings").Value) = True  Then
		usrProtocol = "Activé;"
	Else DescList = objRecordSet.Fields("protocolSettings").Value
		For Each Desc In DescList
			i = InStr(1, Desc, "§", vbTextCompare)
			If Left(Desc, i - 1) = "HTTP" Then
				Desc = Right(Desc, Len(Desc) - i)
				If Left(Desc, 1) = "1" Then
					usrProtocol = "Activé;"
				Else
					usrProtocol = "Désactivé;"
				End If
			End If
		Next
	End If
 
	'Exchange, Option de Remise, Adresse de transfert
	If IsNull(objRecordSet.Fields("altRecipient").Value) = True Then
		usrForward = ";"
	Else
		usrForward = objRecordSet.Fields("altRecipient").Value
		usrForward = Right(usrForward,Len(usrForward)-3)
		MyPos = Instr(1,usrForward,",OU=",vbTextCompare)
		usrForward = Left(usrForward,MyPos -1)  & ";"
	End If
	'Appel entrant, Autorisation d'acces distant
	usrVPN = VPNconvert(objRecordSet.Fields("msNPAllowDialin").Value) & ";"
 
End Function			
 
'_________________________________________________________
'Convertion de la valeur en  texte
Function VPNconvert(VPN)
 
	If VPN = "Vrai" Then
		VPNconvert = "Autorisé"
	ElseIf VPN = "Faux" Then
		VPNconvert = "Refusé"
	Else VPNconvert = "Selon stratégie"
	End If
 
End Function
 
'_________________________________________________________
'Convertion de la valeur décimale en donnée texte
Function MobileConvert(Mobile)
 
	Select Case Mobile
		Case 0 MobileConvert = "OMA, Active Sync, DirectPush"
		Case 1 MobileConvert = "OMA, Active Sync"
		Case 2 MobileConvert = "Active Sync, DirectPush"
		Case 3 MobileConvert = "Active Sync"
		Case 5 MobileConvert = "OMA"
		Case 7 MobileConvert = "Aucun accès"
		Case Else MobileConvert = "OMA, Active Sync, DirectPush"
	End Select
 
End Function

26/09/2008, 18h27
ced600
Code:

1 2 3 4 If IsNull(objRecordSet.Fields("Description").Value) = True Then usrDescript = ";" Else usrDescript = objRecordSet.Fields("Description").Value & ";" End If
Que renvois Value ?
Une chaine de caractère ou un objet ?

Parce que cela :

Code:

IsNull(objRecordSet.Fields("Description").Value) = True

et cela
Code:

1 2 usrDescript = ";" usrDescript = objRecordSet.Fields("Description").Value & ";"
C'est assez antagoniste.

En effet, ce qui te renvoie NULL en général c'est des propriétés et ou des méthodes d'objets, et ce à la place d'un objet car il n'est pas instancié.

Pour affecté à une variable VBS comme valeur un objet, il faut utilisé le mot clé Set devant l'affectation.
Comme cela :

Code:

Set objConnection = CreateObject("ADODB.Connection")

Donc tester avec IsNull si l'affectation s'est déroulé correctement parait logique.

Par contre si la propriété ou la méthode renvois une chaine de caractère, elle ne renvois en général pas NULL (sauf spécification dans la doc).
La valeur NULL pour une chaine de caractère c'est la chaine vide : "".

Donc ton code devrait être soit :
Code:

1 2 3 4 5 If IsNull(objRecordSet.Fields("Description").Value) = True Then usrDescript = ";" Else set usrDescript = objRecordSet.Fields("Description").Value & ";" End If
soit :
Code:

1 2 3 4 5 If objRecordSet.Fields("Description").Value = "" Then usrDescript = ";" Else usrDescript = objRecordSet.Fields("Description").Value & ";" End If
A toi de voir ce que te renvois la vlaue d'un Recordset sur le champ Description.

A d'ailleurs cela me fait penser que de temps à autre les champs de la base de données ont des types différents de ceux existant dans le language, et il y a peut être des conversion à faire. Je ne sais pas comment en VBS on gère cela, ce n'est pas vraiment mon domaine les Bases de Données.
29/09/2008, 14h05
fabrice518

List Users Owa VPN

Bonjour et merci,

en essayant

Code:

If objRecordSet.Fields("Description").Value = "" Then

J'ai l'erreur Type incompatible, 800A000D

et en essayant

Code:

Else set usrDescript = objRecordSet.Fields("Description").Value & ";"

J'ai la meme erreur...

Pour,

Citation:

A toi de voir ce que te renvois la vlaue d'un Recordset sur le champ Description.

J'ai essayé une msgbox mais j'ai tjs la meme erreur.
29/09/2008, 14h30
pitchalov

Le field description te renvoie une chaine de caractère, donc c'est bien la première solution à retenir.

Essaie d'enlever .value, pour voir.

Sinon je pense que tu trouveras pas mal de ces exemples sur le net en général, et en particulier sur le scriptcenter de microsoft, où il y a pas mal d'exemples de manipulation d'AD.