使用 ADO 读取 LDAP 描述
Read LDAP Description using ADO
我正在尝试下面的 LDAP 查询。 "Description" 字段通常为 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
请参阅下面的文字,它将为您排忧解难。
这是从 here
复制的
需要指出的是,用户对象的"description"属性实际上是多值的。但是,它只能有一个值。它被 ADSI 视为普通字符串,但不被 ADO 视为普通字符串。 ADO returns Null(如果 "description" 属性没有值)或一个字符串值的数组。您必须为此属性使用类似于以下的代码。
大多数 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
我正在尝试下面的 LDAP 查询。 "Description" 字段通常为 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
请参阅下面的文字,它将为您排忧解难。 这是从 here
复制的需要指出的是,用户对象的"description"属性实际上是多值的。但是,它只能有一个值。它被 ADSI 视为普通字符串,但不被 ADO 视为普通字符串。 ADO returns Null(如果 "description" 属性没有值)或一个字符串值的数组。您必须为此属性使用类似于以下的代码。
大多数 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