VBA excel Получение информации из активного каталога с именем пользователя в ячейках - PullRequest
0 голосов
/ 03 мая 2018

Я хочу получить данные из активного каталога, у меня есть существующий код, который работает довольно хорошо, за исключением того, что появится сообщение об ошибке:

Ошибка времени выполнения '-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

Спасибо и с нетерпением ждем вашего ответа.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...