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 |
Partager