Results 1 to 13 of 13
  1. #1
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93

    Trying to extract email address from Active Directory

    Hey everyone, I need more help.




    I am creating an IT Trouble Ticket app. All the users are on an Active Directory Domain. I want to pull the existing email address of the logged-in user and prepopulate a text field. I pulled the following example from another site and started modifying it.

    Code:
    Public Function GetEmailAddress(ByVal UserName As String) As String
    
    
        Dim ADObject As Object
        Dim ADUser As Object
        Dim DomainDN As String
    
    
        ' Replace with your domain's root DN (e.g., "LDAP://dc=yourdomain,dc=com")
        DomainDN = "LDAP://" & "form-tec.local"
    
    
        ' Create an Active Directory object
          
        Set ADObject = CreateObject("ADSI.Searcher")
    
    
        ' Set the search parameters
        With ADObject
          .Root = DomainDN
          .SearchScope = 2 ' SearchScope.Subtree
          .Filter = "(sAMAccountName=" & UserName & ")"
          .PropertiesToLoad = Array("mail")
        End With
    
    
        ' Perform the search
        Set ADUser = ADObject.FindOne()
    
    
        ' Check if a user was found
        If Not ADUser Is Nothing Then
            GetEmailAddress = ADUser.Properties("mail").Value
        Else
            GetEmailAddress = "" ' Or handle the "not found" case as needed
        End If
    
    
        ' Clean up
        Set ADUser = Nothing
        Set ADObject = Nothing
    
    
    End Function

    When i get to the " Set ADObject = CreateObject("ADSI.Searcher")", it throws an error 429; "Activex component can't create object"


    Researching the error like a good coder, one of the suggestions is to register the DAO 3.6. I do so, and that is successful. But when I go into References, I see that "Microsoft DAO Object Library" is not checked. When I check it and click "OK", I get "Name conflicts with existing module, project, or object library". I have no modules or projects anywhere close to this name, and my
    References are:
    Visual Basic for Applications
    Microsoft Access 16.0 Object Library
    OLE Automation
    Microsoft Office 16.0 Access database engine Object Library
    Microsoft Outlook 16.0 Object Library


    Can anyone help?

  2. #2
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,569
    And just where does ADSI.Searcher come from?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  3. #3
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,569
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  4. #4
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 11 Office 365
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,879
    Isn't DAO now included in Microsoft Office 16.0 Access database engine Object Library?
    If this helped, please click the star * at the bottom left and add to my reputation- Thanks

  5. #5
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93
    Quote Originally Posted by Welshgasman View Post
    I attempted to post there first, exactly as I typed it here. I kept getting blocked without any real explanation. So I actually cross-posted here. I can't get past why I am getting blocked, so my real issue is not being addressed there.

  6. #6
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93
    Quote Originally Posted by moke123 View Post
    Isn't DAO now included in Microsoft Office 16.0 Access database engine Object Library?
    Whether it is or not, it is not working. I just want to know why that error is being thrown. Researching, I came across that code I tried. I guess it's from an older version which did not have DAO included.

  7. #7
    Gicu's Avatar
    Gicu is offline VIP
    Windows 10 Access 2013 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,250
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

  8. #8
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,569
    Here is what chatgpt offers
    Code:
    Function GetEmailFromAD(ByVal username As String) As String
        Dim conn As Object
        Dim cmd As Object
        Dim rs As Object
        Dim email As String
        Dim domain As String
    
    
        ' Replace with your domain's base DN
        domain = "DC=yourdomain,DC=com"
    
    
        ' Create the ADODB Connection
        Set conn = CreateObject("ADODB.Connection")
        conn.Provider = "ADsDSOObject"
        conn.Open "Active Directory Provider"
    
    
        ' Create the command
        Set cmd = CreateObject("ADODB.Command")
        Set cmd.ActiveConnection = conn
        cmd.CommandText = "SELECT mail FROM 'LDAP://" & domain & "' WHERE sAMAccountName='" & username & "'"
        cmd.Properties("Page Size") = 1000
        cmd.Properties("Timeout") = 30
        cmd.Properties("Cache Results") = False
    
    
        ' Execute the query
        Set rs = cmd.Execute
    
    
        ' Get the email if found
        If Not rs.EOF Then
            email = rs.Fields("mail").Value
            GetEmailFromAD = email
        Else
            GetEmailFromAD = "Not Found"
        End If
    
    
        ' Clean up
        rs.Close
        Set rs = Nothing
        Set cmd = Nothing
        conn.Close
        Set conn = Nothing
    End Function
    with the caveat
    �� Requirements:

    • Enable Microsoft ActiveX Data Objects 2.x Library in the VBA editor (go to Tools > References).
    • Replace DC=yourdomain,DC=com with your actual domain name.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  9. #9
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93

    No, not really. I tried.

  10. #10
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93
    Quote Originally Posted by Welshgasman View Post
    Here is what chatgpt offers
    Code:
    Function GetEmailFromAD(ByVal username As String) As String
        Dim conn As Object
        Dim cmd As Object
        Dim rs As Object
        Dim email As String
        Dim domain As String
    
    
        ' Replace with your domain's base DN
        domain = "DC=yourdomain,DC=com"
    
    
        ' Create the ADODB Connection
        Set conn = CreateObject("ADODB.Connection")
        conn.Provider = "ADsDSOObject"
        conn.Open "Active Directory Provider"
    
    
        ' Create the command
        Set cmd = CreateObject("ADODB.Command")
        Set cmd.ActiveConnection = conn
        cmd.CommandText = "SELECT mail FROM 'LDAP://" & domain & "' WHERE sAMAccountName='" & username & "'"
        cmd.Properties("Page Size") = 1000
        cmd.Properties("Timeout") = 30
        cmd.Properties("Cache Results") = False
    
    
        ' Execute the query
        Set rs = cmd.Execute
    
    
        ' Get the email if found
        If Not rs.EOF Then
            email = rs.Fields("mail").Value
            GetEmailFromAD = email
        Else
            GetEmailFromAD = "Not Found"
        End If
    
    
        ' Clean up
        rs.Close
        Set rs = Nothing
        Set cmd = Nothing
        conn.Close
        Set conn = Nothing
    End Function
    with the caveat
    �� Requirements:


    • Enable Microsoft ActiveX Data Objects 2.x Library in the VBA editor (go to Tools > References).
    • Replace DC=yourdomain,DC=com with your actual domain name.
    Well. OK. I will check it out. Thanks. I'm kind of frightened of AI solving our programming problems, aren't you? To be provided a solution without context, explanation, or background. But hey, for now, I'll take what I can get.

  11. #11
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,569
    No. I do not take the code blindly.
    I check it out and amend as needed.
    As with most code, there are several ways to achieve the outcome.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  12. #12
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93
    Welshgasman: I have Microsoft ActiveX Data Objects 2.0 - 2.8. Are they cumulative? can I just reference 2.8? I also have a 6.1? Would a 6.2 have all of 2.x?

  13. #13
    pledbetter is offline Advanced Beginner
    Windows 11 Access 2019
    Join Date
    Jan 2010
    Location
    Martinsville, IN
    Posts
    93
    Well the AI suggestion worked. Frighteningly well. I think I my own question about the ActiveX Data Objects. It simply will not allow you to enter more than one Microsoft Data Objects 2.x. It complains about duplicates. It does the same thing if I try to also load the 6.1. I guess I will load it by itself and see if the code still works!

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Return active email address
    By DMT Dave in forum Access
    Replies: 10
    Last Post: 08-16-2021, 10:10 AM
  2. Replies: 1
    Last Post: 01-11-2014, 12:39 PM
  3. How To Get Email from Active Directory
    By bignate in forum Programming
    Replies: 6
    Last Post: 12-10-2013, 06:25 AM
  4. Replies: 6
    Last Post: 10-26-2012, 12:53 PM
  5. Replies: 6
    Last Post: 06-15-2011, 04:38 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums