MS Access 2010 using ldap authentication

Question

I am trying to do ldap authentication in ms access 2010 using username and password. I cannot seem to figure this out and have tried different codes online but none seem to work. Can anyone help?

The following is what i have taken from here

Function CheckUser(username As String, passwd As String, Level As Integer) As Boolean

    On Error GoTo LDAP_Error

    username = "sharifu"
    passwd = "xxx"

    Const ADS_SCOPE_SUBTREE = 2

    Dim LDAPPath As String
    LDAPPath = "LDAP://172.16.0.12/OU=Sites;DC=domain;DC=com"

    Dim conn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset

    Set conn = New ADODB.Connection
    Set cmd = New ADODB.Command
    conn.Provider = "ADsDSOObject"

    conn.Properties("User ID") = "domain\" & username
    conn.Properties("Password") = "" & passwd
    conn.Properties("Encrypt Password") = True
    'conn.Properties("ADSI Flag") = 3

    conn.Open "Active Directory Provider"
    Set cmd.ActiveConnection = conn

    cmd.Properties("Page Size") = 1000
    cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE


    cmd.CommandText = _
    "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

    Set rs = cmd.Execute

    rs.Close
    conn.Close

    CheckUser = True
    Exit Function

LDAP_Error:

    If Err.Number = -2147217911 Then

    MsgBox "Incorrect PeopleSoftID or Password!", vbExclamation, "HILDA"

    Else

    MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "HILDA"

    End If
    CheckUser = False

    conn.Close


End Function

Error I receive is

"Error: The server is not operational. -2147217865"

Changed to ip address get following error now

Method 'ActiveConnection' of object '_Command' failed but it might be coming from elsewhere in my code. how would i check if ldap was success?

Answer 1

Making little changes and explaining for understanding this code and a correct functioning:

1. Added the check if the user exist in the Database.
2. Changed "OU=Sites" in the LDAP path by "CN=Users".

LDAPPath = "LDAP://replace with IP or DNS name/CN=Users;DC=replace with domain name without .com;DC=replace with com, net or root node name"

3. In IP or DNS Name you must to specify the server IP or DNS Name.
4. In the first "DC" you must to specify the Domain Name without .com or .net would be like this "google".
5. In the second "DC" you must to specify the Domain type for intance "com", you can see this post if you want to know what means

Full example:

LDAPPath = "LDAP://200.201.1.1/CN=Users;DC=google;DC=com"

or

LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"

6. In this line: conn.Properties("User ID") = "replace with domain short name\" & userName

conn.Properties("User ID") = "ggle\" & userName

Finaly this the full code:

    Function ldapAuth(userName As String, passwd As String, level As Integer) As Boolean

    On Error GoTo LDAP_Error
    ldapAuth = False

    If Not IsNull(userName) And Not IsNull(passwd) Then

    'Check if the user exist in DB
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As QueryDef
    Dim strSQL As String

    Set dbs = CurrentDb

    strSelect = "SELECT *"
    strFrom = " FROM employee"
    strWhere = " WHERE user_name = '" & userName & "';"
    strSQL = strSelect & strFrom & strWhere

    Debug.Print strSQL

    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    'If the recordset is empty, exit.
    If rst.EOF Then
        MsgBox "The user not exist in the DataBase!!!"
    Else
        'Check user with LDAP
        Const ADS_SCOPE_SUBTREE = 2

        Dim LDAPPath As String
        LDAPPath = "LDAP://ldap.google.com/CN=Users;DC=google;DC=com"

        Dim conn As ADODB.Connection
        Dim cmd As ADODB.Command
        Dim rs As ADODB.Recordset

        Set conn = New ADODB.Connection
        Set cmd = New ADODB.Command
        conn.Provider = "ADsDSOObject"
        conn.Properties("User ID") = "ggle\" & userName
        conn.Properties("Password") = "" & passwd
        conn.Properties("Encrypt Password") = True
        'conn.Properties("ADSI Flag") = 3
        conn.Open "Active Directory Provider"

        Set cmd.ActiveConnection = conn
        cmd.Properties("Page Size") = 1000
        cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
        cmd.CommandText = "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

        Set rs = cmd.Execute
        rs.Close
        conn.Close

        'Set userId and Role Globally
        employeeId = rst![id]
        employeeType = rst![employee_type]
        TempVars.Add "employeeId", employeeId
        TempVars.Add "employeeType", employeeType

        'Log user login and role
        Debug.Print "User login: " & TempVars!employeeId
        Debug.Print "User Role: " & TempVars!employeeType

        ldapAuth = True

        rst.Close

      End If

    End If

    Exit Function

    LDAP_Error:

    If Err.Number = -2147217911 Then
    'MsgBox "Incorrect User or Password!", vbExclamation, "LDAP Authentication"
    Else
    MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "LDAP Authentication"
    End If

    conn.Close

    End Function

Answer 2

I have fixed issue.

Function CheckUser(UserName As String, passwd As String, Level As Integer) As Boolean

    On Error GoTo LDAP_Error

    Const ADS_SCOPE_SUBTREE = 2

    Dim LDAPPath As String
    LDAPPath = "LDAP://akutan.country.domain.com/OU=Sites;DC=domain;DC=com"

    Dim conn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset

    Set conn = New ADODB.Connection
    Set cmd = New ADODB.Command
    conn.Provider = "ADsDSOObject"
    conn.Properties("User ID") = "xxx\" & UserName
    conn.Properties("Password") = "" & passwd
    conn.Properties("Encrypt Password") = True
    'conn.Properties("ADSI Flag") = 3
    conn.Open "Active Directory Provider"

    Set cmd.ActiveConnection = conn
    cmd.Properties("Page Size") = 1000
    cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    cmd.CommandText = "SELECT Name FROM '" & LDAPPath & "' WHERE " & "objectCategory='user'"

    Set rs = cmd.Execute
    rs.Close
    conn.Close

    CheckUser = True
    [TempVars]![CurrentUser] = UserName
    Call LogUser([TempVars]![CurrentUser], "Logon")
    Exit Function

LDAP_Error:

    If Err.Number = -2147217911 Then
        MsgBox "Incorrect PeopleSoftID or Password!", vbExclamation, "LDAP Authentication"
    Else
        MsgBox "Error : " & Err.Description & " " & Err.Number, vbExclamation, "LDAP Authentication"
    End If

    CheckUser = False
    conn.Close

End Function