使用ADO

时间:2015-08-12 16:21:13

标签: vba excel-vba ldap ado ldap-query

我正在尝试下面的LDAP查询。 “描述”字段通常为空,但如果存在数据,则会在RS.Fields(vFields(iCol))上出现类型不匹配错误。描述列的值。 ADO数据类型报告为12 - Variant。我试图将值赋给VBA Variant,但它没有用。

请原谅写入文件的无关行。如果您尝试重现,则需要参考Microsoft ADO 6。也改为你的OU

如何在VBA中使用ADP数据类型12?我可以修改SELECT语句以隐藏描述另一种数据类型吗?

        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

1 个答案:

答案 0 :(得分:1)

请参阅下面的文字,它会将您排除在外。 这是从here

复制而来的

应该指出的是"描述"用户对象的属性实际上是多值的。但是,它只能有一个值。它被ADSI视为普通字符串,但不是ADO。 ADO返回Null(如果"描述"属性没有值)或一个字符串值的数组。您必须为此属性使用类似于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