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
| Function getInfos(logon As String) As Variant
Dim InfosUser As Variant
Dim nomLdap As String, prenomLdap As String, serviceLdap As String
Dim objUser As IADs
Dim oConnection As New ADODB.Connection
Dim oCommand As New ADODB.Command
Dim RS As ADODB.Recordset
Dim strQuery As String
Dim Cls As IADsClass
On Error Resume Next
'Connexion
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
'Requete LDAP
strQuery = "<LDAP://monserveur/l=maboite,ou=internes,o=elv,o=mongroupe,c=ww>;(&(objectClass=elvUser)(elvLogon1=" & logon & "));adspath,cn;subtree"
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set RS = oCommand.Execute
If RS.RecordCount = 0 Then
strQuery = "<LDAP://monserveur/l=maboite,ou=externes,o=elv,o=mongroupe,c=ww>;(&(objectClass=elvUser)(elvLogon1=" & logon & "));adspath,cn;subtree"
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set RS = oCommand.Execute
End If
'Recupération des infos de l'utilisateur
If RS.RecordCount <> 0 Then
While Not RS.EOF
Set objUser = GetObject(RS.Fields("adspath"))
objUser.GetInfo
nomLdap = objUser.LastName
prenomLdap = objUser.FirstName
serviceLdap = objUser.Get("elvSigleCondense")
service = objUser.elvSigleCondense
Set Cls = GetObject(objUser.Schema)
Debug.Print "Class Name is: " & Cls.Name
' Affichage des OptionalProperties du Schema
For Each op In Cls.OptionalProperties
If op = "elvSigleCondense" Then
Debug.Print "Optional Property: " & op
Debug.Print "Valeur: " & objUser.Get(op)
End If
Next op
RS.MoveNext
Wend
Else
nomLdap = "INCONNU"
End If
Set objUser = Nothing
RS.Close
Set RS = Nothing
InfosUser = Array(nomLdap, prenomLdap, serviceLdap)
getInfos = InfosUser
End Function |
Partager