Help with Active Directory Code

[DanielWalters6]

Hi,

I'm trying to return information about a user using VB and Active Directory,
all my searching the www has given me the following code.

However the result, when I pass in the username which I need to find
information for, is BLANK.

Can anyone provide any insight to what I'm doing wrong?
Thank you
-----
Public Function UserInfo(LoginName As String) As String
'PURPOSE: Display information that is available in
'the Active Directory about a given user

'PARAMETER: Login Name for user

'RETURNS: String with selected information about
'user, or empty string if there is no such
'login on the current domain

'REQUIRES: Windows 2000 ADSI, LDAP Provider
'Proper Security Credentials.

'EXAMPLE: msgbox UserInfo("Administrator")

Dim Connection As New ADODB.Connection
Dim RecordSet 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 Details As String

Dim user As IADsUser

On Error GoTo ErrHandler:

'Get user Using LDAP/ADO. There is an easier way
'to bind to a user object using the WinNT provider,
'but this way is a better for educational purposes
Set oRoot = GetObject("LDAP://rootDSE")
'work in the default domain
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & sDomain)
sBase = "<" & oDomain.ADsPath & ">"
'Only get user name requested
sFilter = "(&(objectCategory=peRecordSeton)(objectClass=user)(name=" _
& LoginName & "))"
sAttribs = "adsPath"
sDepth = "subTree"

sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

Connection.Open _
"Data Source=Active Directory Provider;Provider=ADsDSOObject"

Set RecordSet = Connection.Execute(sQuery)

If Not RecordSet.EOF Then
Set user = GetObject(RecordSet("adsPath"))
With user

'if the attribute is not stored in AD,
'an error will occur. Therefore, this
'will return data only from populated attributes
On Error Resume Next

Details = "FiRecordSett Name: " & .FiRecordSettName & Chr(10)
Details = Details & "Last Name " & .LastName & Chr(10)
Details = Details & "Employee ID: " & .EmployeeID & Chr(10)
Details = Details & "Title: " & .Title & Chr(10)
Details = Details & "Division: " & .Division & Chr(10)
Details = Details & "Department: " & .Department & Chr(10)
Details = Details & "Manager: " & .Manager & Chr(10)

Details = Details & "Phone Number: " & .TelephoneNumber & Chr(10)
Details = Details & "Fax Number: " & .FaxNumber & Chr(10)

Details = Details & "Email Address: " & .EmailAddress & Chr(10)
Details = Details & "Web Page: " & .HomePage & Chr(10)
Details = Details & "Last Login: " & .LastLogin & Chr(10)
Details = Details & "Last Logoff: " & .LastLogoff & Chr(10)

Details = Details & "Account Expiration Date: " _
& .AccountExpirationDate & Chr(10)

'IN RC2, this returned 1/1/1970 when password
'never expires option is set
Details = Details & "Password Expiration Date: " _
& .PasswordExpirationDate

End With
End If
UserInfo = Details

ErrHandler:

On Error Resume Next
If Not RecordSet Is Nothing Then
If RecordSet.State <> 0 Then RecordSet.Close
Set RecordSet = Nothing
End If

If Not Connection Is Nothing Then
If Connection.State <> 0 Then Connection.Close
Set Connection = Nothing
End If

Set oRoot = Nothing
Set oDomain = Nothing
End Function
-----