Как я могу отобразить результаты из активного каталога в диапазоне ячеек

Question

Я использую макрос, который извлекает имена сотрудников из активного каталога, используя номер отдела. Мне нужно иметь возможность отображать каждого сотрудника, обнаруженного в диапазоне ячеек, предпочтительно Range("A1:A10"). Мой текущий макрос перечисляет все результаты в Range("B3"). Любая помощь с этим будет оценена. Я разбил свой код на две части. Первая часть вызывается, когда сотрудник нажимает кнопку в пользовательской форме, вторая часть - это функция, которая подключается к активной директории:

Sub связан с кнопкой на пользовательской форме

Sub opsldap()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
struser = opslogin.TextBox1
struserdn = Get_LDAP_User_Properties("user", "department", struser, "displayName")
    If Len(struserdn) <> 0 Then
        ws.Range("B3").Value = struserdn
        MsgBox "Welcome to Op's Vision " & struserdn
    Else
        MsgBox "Cant Find"
    End If
End Sub

Функция для получения результатов из Active Directory

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    On Error GoTo EarlyExit

    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
EarlyExit:
    On Error GoTo 0
End Function

Answer 1

Я использую разделенный массив:

Sub opsldap()
    Dim textstring As String, Warray() As String, counter As Integer, strg As String
    struser = opslogin.TextBox1
    struserdn = Get_LDAP_User_Properties("user", "department", struser, "displayName")

If Len(struserdn) <> 0 Then
    textstring = struserdn
    Warray() = split(textstring, vbNewLine)

    For counter = LBound(Warray) To UBound(Warray)

    strg = Warray(counter)
    Cells(counter + 3, 1).Value = Trim(strg)

Next counter

Else
    MsgBox "I couldnt locate that cost center"

End If
End Sub