By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,339 Members | 1,693 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,339 IT Pros & Developers. It's quick & easy.

How can you run a Query using Active Directory values?

P: 19
Hey,

So I originally had a form asking for an ID and password. A query would take those two values and pull up information in a database that contained both those values. I need to change this so that instead of a user putting in this information, the query will look up both of these values in the active directory and pull up information on the user.

Any ideas of how I might go about this?

I am using Access 2007
Thank you.
Jul 1 '10 #1

✓ answered by Raven7738

My final solution:

Expand|Select|Wrap|Line Numbers
  1. Private Declare Function WNetGetUser Lib "mpr.dll" _
  2. Alias "WNetGetUserA" (ByVal lpName As String, ByVal sUser As String, lpnLength As Long) As Long
  3.  
  4. Private Sub Form_Load()
  5.  
  6. Const lpnLength As Integer = 255
  7. Dim status As Integer
  8. Dim lpName, sUser As String
  9. Dim Edt As String
  10.  
  11.  
  12.  
  13. sUser = Space$(lpnLength + 1)
  14. status = WNetGetUser(lpName, sUser, lpnLength)
  15.  
  16. If status = NoError Then
  17.     sUser = Left$(sUser, InStr(sUser, Chr(0)) - 1)
  18.     Else
  19.         MsgBox "Unable to get the name."
  20.     End
  21. End If
  22.  
  23. txtUser = sUser
  24.  
  25. End Sub
  26.  
Thank you for all your input!

Share this Question
Share on Google+
8 Replies


ADezii
Expert 5K+
P: 8,699
@Raven7738
The Syntax would be comparable to this:
Expand|Select|Wrap|Line Numbers
  1. 'First, you must set a Reference to the Active DS Type Library
  2. Dim sysInfo As Object
  3. Dim oUser As Object
  4. Dim intUser As Integer
  5. Dim strLastName As String
  6. Dim strFirstName As String
  7. Dim strSQL As String
  8.  
  9. Set sysInfo = CreateObject("ADSystemInfo")
  10. Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")
  11.  
  12. strUserName = sysInfo.UserName
  13.  
  14. intUser = InStr(strUserName, ",")
  15. strLastName = Mid(strUserName, 4, (intUser - 4))
  16.  
  17. strFirstName = Right(strUserName, ((Len(strUserName) - intUser) - 3))
  18. intUser = InStr(strFirstName, ",")
  19. strFirstName = Left(strFirstName, intUser - 1)
  20.  
  21. 'Set Criteria on Employees Table based on the First and Last Name
  22. strSQL = "SELECT * FROM Employees WHERE [FirstName] = '" & strFirstName & _
  23.          "' AND [LastName] = '" & strLastName & "';"
  24.  
  25. Set sysInfo = Nothing
  26. Set oUser = Nothing
Jul 1 '10 #2

maxamis4
Expert 100+
P: 295
@Raven7738
Here are a couple links to get you started. The previous post gives you a good way of doing it already:

http://activexperts.com/activmonitor...ordExpires.htm

http://www.petri.co.il/ldap_search_s...d_exchange.htm

Here are the general variables used:
'###### Active Directory variables ######
strName = usr.get("givenName") '###### Users Christian Name ######
strSurname = usr.get("sn") '###### Users Surname ######
strInitials = usr.get("initials") '###### Users Initials ######
displayName = usr.get("displayName") '###### Full Display Name ######
strAddress = usr.get("StreetAddress") '###### Address Information ######
strRoom = usr.get("PhysicalDeliveryOfficeName") '###### Room/Area Information ######
secretary = usr.get("secretary") '###### Secrectary/Assistant ######
strTitle = usr.get("title") '###### Job Title ######
strTelephone = usr.get("telephoneNumber") '###### Official Intneral Telephone Number ######
strFax = usr.get("facsimileTelephoneNumber") '###### Fax Number ######
mobile = usr.get("mobile") '###### Mobile Number ######
telephoneAssistant = usr.get("telephoneAssistant") '###### Telephone Assistant ######
strDepartment = usr.get("department") '###### Department ######
strCC = usr.get("ExtensionAttribute1") '###### COST Centre ######
strBuilding = usr.get("ExtensionAttribute2") '###### Building ######
strDivision = usr.get("ExtensionAttribute3") '###### Division ######
strBranch = usr.get("ExtensionAttribute4") '###### Branch ######
ExtensionAttribute5 = usr.get("ExtensionAttribute5") '###### PC Item Number ######
ExtensionAttribute6 = usr.get("ExtensionAttribute6") '###### External Telephone Number ######
strGroup = usr.get("ExtensionAttribute7") '###### Group ######
othertelephone = usr.get("othertelephone") '###### GTN Telephone Number ######
samaccountname = usr.get("samaccountname") '###### User ID ######
adspath = usr.get("adspath") '###### Pathway to AD? ######
strFullName = usr.get("cn") '###### Full Display Name ######
strMail = usr.get("mail") '###### E-Mail Address ######
strManager = usr.get("manager")
Jul 3 '10 #3

NeoPa
Expert Mod 15k+
P: 31,768
As passwords are never stored unencrypted (by professionals at least and certainly not in the AD) it won't be possible to compare the password data at all.

I'm afraid I don't know AD well enough to point you at a method for checking the credentials. I suspect there may be one, but I'm not certain, as even for a standard PC log on, it will only allow the check if the account for the PC itself has already been verified (IE. The PC must be a member of the domain itself or, alternatively, a member of a trusted domain).

I think these waters may be murkier than you'd imagined, but good luck anyway.
Jul 5 '10 #4

P: 19
My final solution:

Expand|Select|Wrap|Line Numbers
  1. Private Declare Function WNetGetUser Lib "mpr.dll" _
  2. Alias "WNetGetUserA" (ByVal lpName As String, ByVal sUser As String, lpnLength As Long) As Long
  3.  
  4. Private Sub Form_Load()
  5.  
  6. Const lpnLength As Integer = 255
  7. Dim status As Integer
  8. Dim lpName, sUser As String
  9. Dim Edt As String
  10.  
  11.  
  12.  
  13. sUser = Space$(lpnLength + 1)
  14. status = WNetGetUser(lpName, sUser, lpnLength)
  15.  
  16. If status = NoError Then
  17.     sUser = Left$(sUser, InStr(sUser, Chr(0)) - 1)
  18.     Else
  19.         MsgBox "Unable to get the name."
  20.     End
  21. End If
  22.  
  23. txtUser = sUser
  24.  
  25. End Sub
  26.  
Thank you for all your input!
Jul 6 '10 #5

NeoPa
Expert Mod 15k+
P: 31,768
Thanks for posting Raven. I'm a little unclear though, does that handle the password or logging in side of things? I can't see where if it does. Getting the password is the tricky bit of course.
Jul 7 '10 #6

maxamis4
Expert 100+
P: 295
This is one of my functions used for LDAP authentication. Not sure if we are done with the post but it works well.

Keep in mind it only checks to make sure the password and user ID are accurate in AD.

Expand|Select|Wrap|Line Numbers
  1.  
  2.  
  3. Function LDAP_Password_Authentication(txtname, txtPassword, MyDomain)
  4. On Error GoTo Err_Form_Timer
  5.     Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName, strCN, strLastLogin
  6.     Dim DomainString As String
  7.  
  8. '======================================================================
  9. 'SET DOMAIN LOGIN
  10. '======================================================================
  11. DomainString = MyDomain & "\" & txtname
  12. '======================== END DOMAIN LOGIN ============================
  13.  
  14. '======================================================================
  15. ' Setup ADO objects.
  16. '======================================================================
  17.  
  18.     Set adoCommand = CreateObject("ADODB.Command")
  19.     Set adoConnection = CreateObject("ADODB.Connection")
  20.     adoConnection.Provider = "ADsDSOObject"
  21.     adoConnection.Open "Active Directory Provider"
  22.     adoCommand.ActiveConnection = adoConnection
  23.  
  24. '===========================END ADO SETUP==============================
  25.  
  26.  
  27. '======================================================================
  28. 'CONNECTION TO LDAP
  29. '======================================================================
  30.     ' Search entire Active Directory domain.
  31.  
  32.     Set objRootDSE = GetObject("LDAP://RootDSE")
  33.  
  34.     strDNSDomain = objRootDSE.Get("defaultNamingContext")
  35.     strBase = "<LDAP://" & strDNSDomain & ">;"
  36.  
  37. '=========================END CONNECTION===============================
  38.  
  39. '======================================================================
  40. 'SETUP CRITERIA
  41. '======================================================================
  42.     strBaseDN = strBase
  43.     strFilter = "(&(objectClass=user)(objectCategory=person));"
  44.     strAttrs = "cn;"
  45.     strScope = "subtree"
  46. '==========================END CRITERIA================================
  47.  
  48.     Set objConn = CreateObject("ADODB.Connection")
  49.     objConn.Provider = "ADsDSOObject"
  50.     objConn.Properties("User ID") = DomainString
  51.     objConn.Properties("Password") = txtPassword
  52.     objConn.Open "Active Directory Provider"
  53.  
  54.     'SEND AUTHENTICATION INFORMATION
  55.     On Error GoTo myError
  56.  
  57.     Set objRS = objConn.Execute(strBaseDN & strFilter & strAttrs & strScope)
  58.  
  59.  
  60.         LDAP_Password_Authentication = True
  61.  
  62. '*****************UPDATE PASSWORD FIELD NOTE STORED FOR 30 DAYS*************************
  63. 'OPEN DATABASE CONNECTION////////////////////////////////////
  64. rsql = "AUTHENTICATE PASSWORD AND USERID AGAINST ACCESS TABLE"
  65.  
  66. Set db = CurrentDb()
  67. Set rs = db.OpenRecordset(rsql, dbOpenDynaset)
  68. '////////////////////////////////////////////////////////////
  69.             rsql = "UPDATE LOG ENTRY FOR USER AUTHENTICATING"
  70.             CurrentDb.Execute (rsql)
  71.  
  72. '***************************END FIELD UPDATE*****************************************************
  73. myError:
  74.     If Err.Number <> 0 Then
  75.         'MsgBox "failed " & Err.Description
  76.         LDAP_Password_Authentication = False
  77.  
  78.     End If
  79.  
  80.  
  81. SET rs = Nothing
  82.  
  83. SET rsql = Nothing
  84.  
  85. Exit_Form_Timer:
  86.     Exit Function
  87.  
  88. Err_Form_Timer:
  89.     MsgBox "Server could not be found please check connection"
  90.     Resume Exit_Form_Timer
  91.  
  92.  
  93.  
  94. End Function
  95.  
  96.  
  97.  
Jul 7 '10 #7

P: 19
@NeoPa
The password is no longer needed. Originally I had it so that the user had to manually log in, so the password was only so others couldn't edit others information. Now the code pulls the username from the already logged in user and filters information from the database using that information. The username is output into a hidden text field (txtUser) which a query uses as a filter.
Jul 7 '10 #8

NeoPa
Expert Mod 15k+
P: 31,768
That makes perfect sense Raven.

Just for clarity though, and to include other possible options, I include links to a couple of threads (Retrieve User ID & Function to Return UserName (NT Login) of Current User) that work on similar lines.
Jul 7 '10 #9

Post your reply

Sign in to post your reply or Sign up for a free account.