Excel VBA-正确获取用户LDAP字符串

Question

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

Answer 1

try to wrap critical code to handle error, eg:

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

Answer 2

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