LDAP connections and querying help (1 Viewer)

[munkee]

Hi all,
I am having trouble with connecting to my companies LDAP to retrieve userinfo. I can return basic information from my local area using the following connection settings:

Set oRoot = GetObject("[URL]ldap://rootDSE[/URL]")
'work in the default domain
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & sDomain)
sBase = "<" & oDomain.ADsPath & ">"

However this is producing the server as being DC=ww007,DC=mycompany,DC=net. Which does not have available the same information as our company wide ldap.
I have use JXplorer to find my site within our huge directory (over 400k employees) and the connection would be:

ldap://scd2ldap.mycompany.net:389/cn=MCGUINNESS NAME Z002DTRW,l=NUR S,ou=E F,o=mycompany,c=GB??base?(objectClass=*)

The attributes available to me are vast such as gender/department/faxnumber etc etc.
I want to be able to enter the cn value and return all of the other attributes associated with that.
My attempted code has always failed and this is what I am using at the moment:

Option Compare Database
Option Explicit
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 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:
Debug.Print
'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("[URL]ldap://rootDSE[/URL]")
'work in the default domain
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & sDomain)
sBase = "<" & oDomain.ADsPath & ">"
'Only get user name requested
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
    
    '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
    
    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 & "the name yo: " & .name & 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 & "test" & .GetInfo("gender") & vbCrLf
    sAns = sAns & "test " & .Description & vbCrLf
    sAns = sAns & "test " & .ADsPath & vbCrLf
    sAns = sAns & "test11 " & .Class & vbCrLf
    sAns = sAns & "test11emp " & .GraceLoginsAllowed & vbCrLf
    
    sAns = sAns & "Account Expiration Date: " _
         & .AccountExpirationDate & vbCrLf
    
    'IN RC2, this returned 1/1/1970 when password
    'never expires option is set
    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

As stated this is not currently connecting to the company wide ldap as far as I can see, or atleast I am not understanding how to return company specifc attributes.
Anyone able to guide me here? I am complete stumped.

 

[darbid]

if nobody helps you here, which I am guessing they will not you might try here.

http://www.outlookcode.com/forums.aspx

Personally I have never had to do anything directly with LDAP as I have been able to achieve everything through the outlook client.