Question

我不知道我有什么问题，但我无法正确使用这个字符串！我有这张Excel用户信息，我想通过LDAP连接到AD，但我得到这个自动化错误'-2147217900（80040e14）'，这可能意味着LDAP字符串中存在语法错误。现在，我使用此函数来获取用户专有名称。然后我返回并尝试通过adoConnection.Execute传递它。

返回的LDAP字符串如下所示：

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

代码如下所示：

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

这样的功能：

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

尝试包装关键代码以处理错误，例如：

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

好吧，尝试其他的东西。很久以前我为此编写了存储过程，可能会对你有帮助

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

我实际上使用AzAD Scriptomatic得到了答案：）

代码现在看起来像这样：

        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

Excel VBA - 使用户LDAP字符串正确

2 个答案: