Trying to extract email address from Active Directory

[pledbetter]

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.

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?

[Welshgasman]

And just where does ADSI.Searcher come from?

[Welshgasman]

Cross posted at https://www.access-programmers.co.uk...2#post-1958647

[moke123]

Isn't DAO now included in Microsoft Office 16.0 Access database engine Object Library?

[pledbetter]

Cross posted at https://www.access-programmers.co.uk...2#post-1958647

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.

[pledbetter]

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.

[Gicu]

Maybe this helps:
https://stackoverflow.com/questions/...tive-directory
Or this:
https://www.access-programmers.co.uk...access.209929/
Cheers,

[Welshgasman]

Here is what chatgpt offers

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.

[pledbetter]

Maybe this helps:
https://stackoverflow.com/questions/...tive-directory
Or this:
https://www.access-programmers.co.uk...access.209929/
Cheers,

No, not really. I tried.

[pledbetter]

Here is what chatgpt offers

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.

[Welshgasman]

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.

[pledbetter]

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?

[pledbetter]

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!