使用 ADO 读取 LDAP 描述

Question

我正在尝试下面的 LDAP 查询。 “描述”字段通常为 Null，但如果存在数据，我会在描述列的 RS.Fields(vFields(iCol)).Value 上收到类型不匹配错误。 ADO 数据类型报告为 12 - Variant。我尝试将值分配给 VBA 变体，但没有成功。

请原谅多余的行写入文件。如果您尝试重现，需要参考 Microsoft ADO 6。也换成你的 OU

如何在 VBA 中使用 ADP 数据类型 12？我可以修改 SELECT 语句以将 Description 转换为另一种数据类型吗？

        Option Explicit

        Sub GatherAttrs()
        On Error GoTo Local_error
            Dim objShell
            Dim objFSO
            Dim strOutputFileName, objOutputFileName, s, s2
            Dim RS As ADODB.Recordset
            Dim objConnection As ADODB.Connection
            Dim objCommand As ADODB.Command
            Const ForReading = 1, ForWriting = 2, ForAppending = 8
            Dim i As Integer
            Dim iRow As Integer
            Dim iCol As Integer
            Dim wks As Worksheet
            Dim sFields As String
            Dim vFields() As String
            Dim v As Variant

            Set wks = Worksheets.Add()

        '    Set objShell = WScript.CreateObject("WScript.Shell")
        '    Set objFSO = CreateObject("Scripting.FileSystemObject")
        '    strOutputFileName = InputBox("Out filename:", , "UserList2.txt")
        '    Set objOutputFileName = objFSO.OpenTextFile(strOutputFileName, ForWriting, True)
            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


            ' ** ** top 1000
            objCommand.Properties("Page Size") = 1000
            objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE


            sFields = "givenName,initials,sn,displayName,userPrincipalName,sAMAccountName,description,physicalDeliveryOfficeName,telephoneNumber,mail,pager,mobile,facsimileTelephoneNumber,employeeID,employeeNumber,departmentNumber,title,department,company,manager"
            vFields = Split(sFields, ",")

            s = "SELECT "
            s = s & sFields
            ' ** ** modify OU for your scope ** **
            s = s & " FROM 'LDAP://ou=APCD,dc=wings,dc=co,dc=slo,dc=ca,dc=us' "
            s = s & " WHERE objectCategory='user' order by Name"
            objCommand.CommandText = s

            Set RS = objCommand.Execute

            If RS.EOF Then
                MsgBox "ADS search failed - check OU" & vbNewLine & objCommand.CommandText
                GoTo Local_Exit
            End If
            iRow = 1
            For iCol = 1 To UBound(vFields)
                wks.Cells(iRow, iCol) = vFields(iCol)
            Next iCol

            RS.MoveFirst
            Do Until RS.EOF
                iRow = iRow + 1
                For iCol = 1 To UBound(vFields)
                    v = RS.Fields(vFields(iCol)).Value
                    wks.Cells(iRow, iCol) = RS.Fields(vFields(iCol)).Value & ""
                Next iCol
                RS.MoveNext
            Loop
        '    objOutputFileName.Writeline (s)
        '    objOutputFileName.Close
            'Wscript.Echo s
            wks.Activate
        Local_Exit:
            Exit Sub
        Local_error:
            MsgBox Err & " " & Err.Description
            If Err.Number = 13 Then Resume Next
            Resume Local_Exit
            Resume
            Resume Next
        End Sub

---

建议答案后的最终代码。

RS.MoveFirst
Do Until RS.EOF
    iRow = iRow + 1
    For iCol = 1 To UBound(vFields)
        If RS.Fields(vFields(iCol)).Type = 12 Then
             If Not IsNull(RS.Fields(vFields(iCol))) Then
                vData = RS.Fields(vFields(iCol)) ' vData is declared as a Variant
                wks.Cells(iRow, iCol) = vData(0) & "" ' only captures first array element
             End If
        Else
            wks.Cells(iRow, iCol) = RS.Fields(vFields(iCol)).Value & ""
        End If
    Next iCol
    RS.MoveNext
Loop

Answer 1

请参阅下面的文字，它将为您解决问题。 这是从here复制的

需要指出的是，用户对象的“描述”属性实际上是多值的。但是，它只能有一个值。 ADSI 将其视为普通字符串，但 ADO 不将其视为普通字符串。 ADO 返回 Null（如果“description”属性没有值）或一个字符串值的数组。对于此属性，您必须使用类似于 BELOW 的代码。

大多数 Active Directory 属性都有字符串值，因此您可以直接回显这些值，或将这些值分配给变量。某些 Active Directory 属性不是单值字符串。 ADO 将多值属性作为数组返回。示例包括属性 memberOf、directReports、otherHomePhone 和 objectClass。在这些情况下，如果多值属性中没有值，则 Fields 集合的 Value 属性将为 Null，如果有一个或多个值，则该属性将是一个数组。例如，如果属性列表包括 sAMAccountName 和 memberOf 属性，您可以使用类似于以下的循环枚举 Recordset 对象：

Do Until adoRecordset.EOF
    strName = adoRecordset.Fields("sAMAccountName").Value
    Wscript.Echo "User: " & strName
    arrGroups = adoRecordset.Fields("memberOf").Value
    If IsNull(arrGroups) Then
        Wscript.Echo "-- No group memberships"
    Else
        For Each strGroup In arrGroups
            Wscript.Echo "-- Member of group: " & strGroup
        Next
    End If
    adoRecordset.MoveNext
Loop