Get User info that is stored in the Active Directory

[riti90]

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.

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]

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

 

[Galaxiom]

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.