Thursday, July 12, 2012

LDAP command to Excel

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