Я хочу получить данные из активного каталога, у меня есть существующий код, который работает довольно хорошо, за исключением того, что появится сообщение об ошибке:
Ошибка времени выполнения '-2147016642 (8007203e)':
фильтр поиска не может быть распознан
на это: До тех пор, пока adorecordset.EOF
имя пользователя находится в строке C, и я хочу, чтобы этот скрипт выполнялся для последней значащей ячейки в строке C.
Вот мой код:
Sub test()
Dim lastRow As Integer
Dim i As Integer
Dim ws As Object
Set ws = ThisWorkbook.Worksheets("Send Letters")
lastRow = ws.UsedRange.Count
For i = 9 To lastRow
Cells(i, 4) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpaaka")
Cells(i, 5) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpasurname")
Cells(i, 6) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpaern")
Cells(i, 7) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "title")
Cells(i, 8) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpatruesectioncode")
Cells(i, 9) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpatrueunitcode")
Cells(i, 10) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpajoindate")
Cells(i, 11) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "mail")
Cells(i, 12) = Get_LDAP_User_Properties("user", "samAccountName", Cells(i, 3).Value, "cpatrueportcode")
Next i
End Sub
и:
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
' It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
' For example, if you are searching based on the user account name, strSearchField
' would be "samAccountName", and strObjectToGet would be that speicific account name,
' such as "jsmith". This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return. For example, if you wanted
' the home folder path, as defined by the AD, for a specific user, this would be
' "homeDirectory". If you want to return the ADsPath so that you can bind to that
' user and get your own parameters from them, then use "ADsPath" as a return string,
' then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
If InStr(strObjectToGet, "\") > 0 Then
arrGroupBits = Split(strObjectToGet, "\")
strDC = arrGroupBits(0)
strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
strObjectToGet = arrGroupBits(1)
Else
' Otherwise we just connect to the default domain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strBase = "<LDAP://" & strDNSDomain & ">"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection
' Filter on user objects.
'strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = strCommaDelimProps
arrProperties = Split(strCommaDelimProps, ",")
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
' Define the maximum records to return
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adorecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strReturnVal = ""
Do Until adorecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strReturnVal = "" Then
strReturnVal = adorecordset.Fields(intCount).Value
Else
strReturnVal = strReturnVal & vbCrLf & adorecordset.Fields(intCount).Value
End If
Next
' Move to the next record in the recordset.
adorecordset.MoveNext
Loop
' Clean up.
adorecordset.Close
ADOConnection.Close
Get_LDAP_User_Properties = strReturnVal
End Function
Спасибо и с нетерпением ждем вашего ответа.