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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/6450039/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 11:36:20  来源:igfitidea点击:

Excel VBA - Getting a users LDAP string correct

vbavbscriptactive-directoryexcel-vbaldap

提问by Kenny Bones

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.

我不知道我怎么了,但我不能把这个字符串弄对!我有这个 Excel 用户信息表,我想通过 LDAP 连接到 AD,但我收到此自动化错误“-2147217900 (80040e14)”,这可能意味着 LDAP 字符串中存在语法错误。现在,我使用这个函数来获取用户的专有名称。然后我返回它并尝试通过 adoConnection.Execute 传递它。

The returned LDAP string looks like this:

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

<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

回答by heximal

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

回答by Kenny Bones

I actually got the answer myself using AzAD Scriptomatic :)

我实际上使用 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