We help IT Professionals succeed at work.
Get Started

Excel Code to get Data from Active directory.

2,238 Views
Last Modified: 2012-06-27
Hi,

Excel Code to get Data from Active directory.
The script when run asks for the start and end date and retrieves the Created users details. I want one addition.

To have the managers email ID also next to the managers name. So all the other colums should be next.

Regards
Sharath

Sub Get_Users_Or_Contacts_Created_Between_Dates()
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("defaultNamingContext")
    
    strSheetName = "New NT Login"
    
    Set objSheet = Sheets(strSheetName)
    
    dtmStartDate = InputBox("Enter the start of the date range:", "Start of Date Range", "mm/dd/yyyy")
    dtmEndDate = InputBox("Enter the end of the date range:", "End of Date Range", "mm/dd/yyyy")
    'dtmStartDate = Right("0" & Month(Now), 2) & "/" & Right("0" & Day(Now), 2) & "/" & Year(Now)
    'dtmEndDate = Right("0" & Month(Now), 2) & "/" & Right("0" & Day(Now), 2) & "/" & Year(Now)
    
    Const ADS_SCOPE_SUBTREE = 2
    
    dtmStartDate = Right(dtmStartDate, 4) & Left(dtmStartDate, 2) & Mid(dtmStartDate, 4, 2) & "000000.0Z"
    dtmEndDate = Right(dtmEndDate, 4) & Left(dtmEndDate, 2) & Mid(dtmEndDate, 4, 2) & "115959.0Z"
    'dtmStartDate = "20060101000000.0Z"
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    
    objCommand.CommandText = _
        "SELECT adsPath FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='person' AND (objectClass='user' OR objectClass='contact') " & _
            "AND whenCreated>='" & dtmStartDate & "' AND whenCreated<='" & dtmEndDate & "'"
            
    Set adoRecordset = objCommand.Execute
    ' Enumerate the resulting recordset.
    
    ' Change the column letter here to the first column where data will exist
    intRow = objSheet.Cells(65536, "A").End(xlUp).Row + 1
    Do Until adoRecordset.EOF
        Set objUser = GetObject(adoRecordset.Fields("adsPath").Value)
        strNTLoginColumn = "A"
        boolExists = Check_If_User_Already_In_Sheet(objUser.samAccountName, objSheet, strNTLoginColumn)
        If boolExists = False Then
            objSheet.Cells(intRow, strNTLoginColumn).Value = objUser.samAccountName
            objSheet.Cells(intRow, "B").Value = objUser.whenCreated
            objSheet.Cells(intRow, "C").Value = objUser.Description
            objSheet.Cells(intRow, "D").Value = objUser.DisplayName
            objSheet.Cells(intRow, "E").Value = objUser.mail
            objSheet.Cells(intRow, "F").Value = objUser.Department
            objSheet.Cells(intRow, "G").Value = objUser.Title
            If objUser.Manager <> "" Then
                objSheet.Cells(intRow, "H").Value = Mid(Left(objUser.Manager, InStr(objUser.Manager, ",") - 1), 4)
            End If
            objSheet.Cells(intRow, "I").Value = objUser.Class
            objSheet.Cells(intRow, "J").Value = Split(objUser.distinguishedName, ",")(1)
            intRow = intRow + 1
        End If
        adoRecordset.MoveNext
    Loop
End Sub
 
Function Check_If_User_Already_In_Sheet(ByVal strNTLogin, ByVal objSheet, ByVal strColumn) As Boolean
    boolAnswer = False
    For intRow = 1 To objSheet.Cells(65536, strColumn).End(xlUp).Row
        If LCase(objSheet.Cells(intRow, strColumn).Value) = LCase(strNTLogin) Then
            boolAnswer = True
            Exit For
        End If
    Next
    Check_If_User_Already_In_Sheet = boolAnswer
End Function

Open in new window

Comment
Watch Question
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 14 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE