Excel VBA - Getting a users LDAP string correct

vba vbscript active-directory excel ldap

31,365

Solution 1

I actually got the answer myself using AzAD Scriptomatic :)

Code now looks like this:

        Set objRootDSE = GetObject("LDAP://rootDSE")
        Dim strQuery As String
        strQuery = ("LDAP://" & getUsersDN("dbowie"))

        Set objItem = GetObject(strQuery)

        '***********************************************
        '*         End connect to an object           *
        '***********************************************

        objItem.Put "description", "test"
        objItem.SetInfo

    Public Function getUsersDN(ByVal strUsername As String)
        Const ADS_SCOPE_SUBTREE = 2

        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand = CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection

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

        objCommand.CommandText = _
            "SELECT distinguishedName FROM 'LDAP://dc=myDomain,dc=local' " & _
                "WHERE objectCategory='user' " & _
                    "AND sAMAccountName='" & strUsername & "'"
        Set objRecordSet = objCommand.Execute

        objRecordSet.MoveFirst
        Do Until objRecordSet.EOF
            strDN = objRecordSet.Fields("distinguishedName").Value
            getUsersDN = strDN
            objRecordSet.MoveNext
        Loop
End Function

Solution 2

try to wrap critical code to handle error, e.g:

on error resume next
Set objRecordSet = objCommand.Execute
if err.Number <> 0 then MsgBox "Exception occured: " & err.Description
on error goto 0

ok, try somthing other. long ago i wrote stored procedure for that, may be it would help you

CREATE   PROCEDURE sp_get_ad_user_info (
    @DomainName  varchar (64),
    @AccountName varchar (128)
)
AS
BEGIN
  DECLARE @adsiSQL nvarchar(1024)

  SELECT @adsiSQL = 
     'SELECT samAccountName, Name, mail, Company, l [City], extensionAttribute1 [BirthDay], extensionAttribute2 [HireDay],department,title,telephoneNumber 
      FROM OPENQUERY( ADSI, 
     ''SELECT samAccountName, Name, mail, company, l, extensionAttribute1, extensionAttribute2,department,title,telephoneNumber
      FROM ''''LDAP://' + @DomainName + '''''
      WHERE objectCategory = ''''Person'''' AND objectClass = ''''user'''' AND samAccountName=''''' + @AccountName + '''''' + 
      ''')'

  exec sp_executesql @adsiSQL 

  RETURN 
END

31,365

Author by

Kenny Bones

Updated on June 23, 2020

Comments

Kenny Bones almost 4 years

I don't know what's wrong with me, but I can't get this string right! I've got this Excel sheet of user information and I want to connect to AD via LDAP, but I get this automation error '-2147217900 (80040e14)', which probably means there's a syntax error in the LDAP string. Now, I use this function to pick up the users distinguished name. Then I return that and try to pass it through adoConnection.Execute.

The returned LDAP string looks like this:

<LDAP://CN=Bowie\,David,OU=Geniouses,OU=Music,DC=MasterDomain,DC=local>;ADsPath;subtree

The code looks like this:

ldapStr = "<LDAP://" & getUsersDN("dbowie") & ">;ADsPath;subtree"

Function like this:

Public Function getUsersDN(ByVal strUsername As String)
Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

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

objCommand.CommandText = _
    "SELECT distinguishedName FROM 'LDAP://dc=MasterDomain,dc=local' " & _
        "WHERE objectCategory='user' " & _
            "AND sAMAccountName='" & strUsername & "'"
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    strDN = objRecordSet.Fields("distinguishedName").Value
    getUsersDN = strDN
    objRecordSet.MoveNext
Loop
End Function

Kenny Bones almost 13 years

Ok, this gives me the message: 'Exception occured: One or more errors occurred during processing of command. ' Not much info there really.
Kenny Bones almost 13 years

This is an SQL query isn't it? Can I use that in VBA?
heximal almost 13 years

it's a stored procedure. you must compile it on your SQL Server. ohh... you don't have an SQL Server?
Kenny Bones almost 13 years

Yeah I do, but I'm not very good at SQL really. But this thing should be possible with VBA as well right? It's probably the string that's incorrect. I've got VBA code that imports data from AD. But it targets all users from the domain. So the LDAP string is not as specific as the one targeting the specific user.
heximal almost 13 years

yes, it will be possible with VBA. the difference will be in sql-query. vb script will run not SELECT but exec stored procedure. this procedure will return the result set which will contain all user AD-info
Kenny Bones almost 13 years

I actually figured it out with using ADSI Scriptomatic. I altered the code quite a bit to make it easier to use. And it actually works pretty well :)