Get User info that is stored in the Active Directory (1 Viewer)

Status
Not open for further replies.

riti90

Registered User.
Local time
Today, 15:07
Joined
Dec 20, 2017
Messages
44
I've been working recently in a project where I had to get User's info from Active directory. Had to create a class to call them easy.
Though maybe someone will find it useful.

Code:
Option Compare Database
Option Explicit

'Get User info that is stored in the Active Directory

'First, you must set a Reference to the Active DS Type Library

'Copy the code in a new class module named "clsEmployee".
'And you can call it like this:
'Dim Employees As clsEmployee
'Set Employees = New clsEmployee
'YourTextBox = Employees.FullName
'(or Employees.anything else like Initials, Title, Email, Company, FirstName, LastName, MidName, Phone)

Public Function FullName() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

FullName = oUser.DisplayName
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function Initials() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

Initials = UCase(oUser.sAMAccountName)

'or Initials = UCase(oUser.Initials)
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function Title() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

Title = oUser.Title
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function Email() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

Email = oUser.Mail
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function Company() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

Company = oUser.Company
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function FirstName() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

FirstName = oUser.FirstName
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function LastName() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

LastName = oUser.LastName
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function MidName() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

MidName = oUser.Middlename
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function

Public Function Phone() As String
On Error GoTo Err_Handler

Dim sysInfo As Object
Dim oUser As Object

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName)

Phone = oUser.TelephoneNumber
 
Set sysInfo = Nothing
Set oUser = Nothing

Exit_Handler:
        Exit Function
Err_Handler:
        MsgBox "Runtime Error # " & Err.Number & vbCrLf & vbLf & Err.Description
Resume Exit_Handler
End Function
 

isladogs

MVP / VIP
Local time
Today, 15:07
Joined
Jan 14, 2017
Messages
18,186
Thanks for this code. I'm sure someone will find it useful.
Just for future reference, please see the sticky thread about reporting your own post to moderated areas
 
Last edited:

Galaxiom

Super Moderator
Staff member
Local time
Tomorrow, 02:07
Joined
Jan 20, 2009
Messages
12,849
The Group information is a lot more complex because it is multivalued.

I covered some of that in this thread.

I have still never tackled the process of working out user memberships where groups are member of other groups.
 
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom