Private Sub Worksheet_Change(ByVal Target As Range)
arrAddress = Split(Mid(Target.Address, 2), "$")
strCol = arrAddress(0)
intRow = arrAddress(1)
strObjectType = "user"
strSearchField = Cells(1, strCol).Value
strObjectToGet = Cells(intRow, strCol).Value
strCommaDelimProps = ""
For intCount = 1 To Cells(1, 256).End(xlToLeft).Column
If strCommaDelimProps = "" Then
strCommaDelimProps = Cells(1, intCount).Value
Else
strCommaDelimProps = strCommaDelimProps & "," & Cells(1, intCount).Value
End If
Next
'MsgBox "Get_LDAP_User_Properties(" & strObjectType & "," & strSearchField & "," & strObjectToGet & "," & strCommaDelimProps & ")"
strDetails = Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
arrDetails = Split(strDetails, "|")
'MsgBox strDetails
Application.EnableEvents = False
For intCount = LBound(arrDetails) + 1 To UBound(arrDetails) + 1
Cells(intRow, intCount).Value = arrDetails(intCount - 1)
Next
Application.EnableEvents = True
End Sub
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
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
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strDetails = ""
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
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.
Do Until adoRecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strDetails = "" Then
If IsArray(adoRecordset.Fields(intCount)) = False Then
strDetails = adoRecordset.Fields(intCount).Value
Else
strDetails = Join(adoRecordset.Fields(intCount).Value)
End If
Else
If IsArray(adoRecordset.Fields(intCount)) = False Then
strDetails = strDetails & "|" & adoRecordset.Fields(intCount).Value
Else
strDetails = strDetails & "|" & Join(adoRecordset.Fields(intCount).Value)
End If
End If
Next
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close
Get_LDAP_User_Properties = strDetails
End Function
No comments:
Post a Comment