Read LDAP Description using ADO

Question

I'm trying the LDAP query below. The "Description" field is usually Null but if data is present I get a Type Mismatch error on RS.Fields(vFields(iCol)).Value for the description column. The ADO datatype is reported as 12 - Variant. I tried to assign the value to a VBA Variant but it didn't work.

Please excuse the extraneous lines for writing to a file. Needs reference to Microsoft ADO 6 if you try to reproduce. Also change to your OU

How do I work with ADP Data Type 12 in VBA? Can I modify the SELECT statement to covert Description too another data type?

        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

---

Final code after suggested answer.

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

Please see teh text below which will sort you out. this was copied from here

It should be pointed out that the "description" attribute of user objects is actually multi-valued. However, it can only have one value. It is treated as a normal string by ADSI, but not by ADO. ADO returns either a Null (if the "description" attribute has no value) or an array of one string value. You must use code similar to BELOW for this attribute.

Most Active Directory attributes have string values, so you can echo the values directly, or assign the values to variables. Some Active Directory attributes are not single-valued strings. Multi-valued attributes are returned by ADO as arrays. Examples include the attributes memberOf, directReports, otherHomePhone, and objectClass. In these cases, the Value property of the Fields collection will be Null if there are no values in the multi-valued attribute, and will be an array if there is one or more values. For example, if the list of attributes includes the sAMAccountName and memberOf attributes, you could enumerate the Recordset object with a loop similar to:

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