VBA - Active directory Chercher Utilisateur
Active directory
-
Active directory -
Active directory -
Bonjour,
Je cherche une macro qui permet de vérifier l'existence d'un utilisateur dans Active directory.
L'identifiant est tapé dans un textbox, puis une vérification est faite dans l'AD et renvoit un messagebox.
Quelqu'un sait comment faire?
merci !
Je cherche une macro qui permet de vérifier l'existence d'un utilisateur dans Active directory.
L'identifiant est tapé dans un textbox, puis une vérification est faite dans l'AD et renvoit un messagebox.
Quelqu'un sait comment faire?
merci !
A voir également:
- VBA - Active directory Chercher Utilisateur
- Directory list & print - Télécharger - Divers Utilitaires
- Active partition disk - Télécharger - Stockage
- Pass telecommande active - Forum Téléviseurs
- L'indice n'appartient pas à la sélection vba - Forum VB / VBA
- Comment activé - Guide
2 réponses
J'ai ce code, mais il ne fonctionne pas, j'ai testé d'ajouter toutes les librairies et il bloque sur :
Dim conn As New ADODB.Connection.
Dim conn As New ADODB.Connection.
Dim conn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim oRoot As IADs
Dim oDomain As IADs
Dim sBase As String
Dim sFilter As String
Dim sDomain As String
Dim sAttribs As String
Dim sDepth As String
Dim sQuery As String
Dim sAns As String
Dim user As IADsUser
On Error GoTo ErrHandler:
Set oRoot = GetObject("LDAP://rootDSE")
'work in the default domain
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & sDomain)
sBase = "<" & oDomain.ADsPath & ">"
sFilter = "(&(objectCategory=person)(objectClass=user)(name=" _
& LoginName & "))"
sAttribs = "adsPath"
sDepth = "subTree"
sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth
conn.Open _
"Data Source=Active Directory Provider;Provider=ADsDSOObject"
Set rs = conn.Execute(sQuery)
If Not rs.EOF Then
Set user = GetObject(rs("adsPath"))
With user
sAns = "First Name: " & .FirstName & vbCrLf
sAns = sAns & "Last Name " & .LastName & vbCrLf
sAns = sAns & "Employee ID: " & .EmployeeID & vbCrLf
sAns = sAns & "Title: " & .Title & vbCrLf
sAns = sAns & "Division: " & .Division & vbCrLf
sAns = sAns & "Department: " & .Department & vbCrLf
sAns = sAns & "Manager: " & .Manager & vbCrLf
sAns = sAns & "Phone Number: " & .TelephoneNumber & vbCrLf
sAns = sAns & "Fax Number: " & .FaxNumber & vbCrLf
sAns = sAns & "Email Address: " & .EmailAddress & vbCrLf
sAns = sAns & "Web Page: " & .HomePage & vbCrLf
sAns = sAns & "Last Login: " & .LastLogin & vbCrLf
sAns = sAns & "Last Logoff: " & .LastLogoff & vbCrLf
sAns = sAns & "Account Expiration Date: " _
& .AccountExpirationDate & vbCrLf
sAns = sAns & "Password Expiration Date: " _
& .PasswordExpirationDate
End With
End If
UserInfo = sAns
ErrHandler:
On Error Resume Next
If Not rs Is Nothing Then
If rs.State <> 0 Then rs.Close
Set rs = Nothing
End If
If Not conn Is Nothing Then
If conn.State <> 0 Then conn.Close
Set conn = Nothing
End If
Set oRoot = Nothing
Set oDomain = Nothing
End Function