在Active Directory中获取基于全名的用户部门
我有一个excel文件中的全名用户列表。 我想通过从AD得到他们的全名来自动获得他们的部门。
我的表Tabelle1有一个700多个用户的列表。 在这种情况下，我需要自动完成以节省时间。
基本上，我想根据他们的全名来看AD。 如果他们的全名在AD用户中匹配，则在第7列中，它将放置该部门。
我find一个代码，但我不知道如何继续：
Sub LoadUserInfo() Dim x, objConnection, objCommand, objRecordSet, oUser, skip, disa Dim sht As Worksheet Dim Tabelle1 As Worksheet ' get domain Dim oRoot Set oRoot = GetObject("LDAP://rootDSE") Dim sDomain sDomain = oRoot.Get("defaultNamingContext") Dim strLDAP strLDAP = "LDAP://" & sDomain 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") = 100 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person'AND objectClass='user'" Set objRecordSet = objCommand.Execute x = 2 Set sht = ThisWorkbook.Worksheets("Tabelle1") With sht Do Until objRecordSet.EOF Set oUser = GetObject(objRecordSet.Fields("aDSPath")) skip = oUser.sAMAccountName disa = oUser.AccountDisabled If skip = .Cells(x, 5).Value Then .Cells(x, 7) = oUser.Department DoEvents objRecordSet.MoveNext Else DoEvents x = x + 1 objRecordSet.MoveNext End If Loop End With End Sub 您可以简单地在查询中使用filter来获取匹配用户名的logging。
Sub test() MsgBox GetDepartment("Stark", "Tony") End Sub Function GetDepartment(strLastName As String, strFirstName As String) As String Dim objRoot As Object Dim strDomain As String Dim objConn As Object Dim objComm As Object Dim objRecordset As Object Dim sFilter As String Dim sAttribs As String Dim sDepth As String Dim sBase As String Dim sQuery As String Set objRoot = GetObject("LDAP://RootDSE") strDomain = objRoot.Get("DefaultNamingContext") Set objConn = CreateObject("ADODB.Connection") Set objComm = CreateObject("ADODB.Command") strLastName = Replace(strLastName, Space(1), "") strFirstName = Replace(strFirstName, Space(1), "") sFilter = "(&(objectClass=person)(objectCategory=user)(givenName=" & strFirstName & ")" & "(sn=" & strLastName & "*)" & ")" sAttribs = "department,sAMAccountName,givenName,sn" sDepth = "SubTree" sBase = "<LDAP://" & strDomain & ">" sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth objConn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject" Set objComm.ActiveConnection = objConn objComm.Properties("Page Size") = 40000 objComm.CommandText = sQuery Set objRecordset = objComm.Execute Do Until objRecordset.EOF GetDepartment = objRecordset("department") Exit Function objRecordset.MoveNext Loop End Function