Excel Code to get Data from Active directory.

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

LVL 11
bsharathAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ExcelGuideConsultantCommented:
is it already added to the sheet, so you are looking to have the columns switched? Or is it completely new? Because it looks like column E contains the mailaddress?
0
AngelizedCommented:

Add this line
objSheet.Cells(intRow, "G").Value = GetmanagerEmail(objUser.Manager)
and Add this function at the end
Public Function GetmanagerEmail(sUsername)
    Dim objUser As IADs
    GetmanagerEmail = ""
    Set objUser = GetObject("LDAP://" & sUsername)
   If Not IsEmpty(objUser) Then
       GetmanagerEmail = objUser.Get("mail")
   End If  
End Function
0
bsharathAuthor Commented:
Psychotec
Thats the users email address.

Angelized
I want the Manager Email Address in Colum I and the others moved to the next colum.

When i used the code i get this

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

User-defined type not defined
---------------------------
OK   Help  
---------------------------

I want the manager name in colum H as it is and I should have the  Manager Email address and the other I,J,K,L should be moved next
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

bsharathAuthor Commented:
Psychotec
Thats the users email address.

Angelized
I want the Manager Email Address in Colum I and the others moved to the next colum.

When i used the code i get this

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

User-defined type not defined
---------------------------
OK   Help  
---------------------------

I want the manager name in colum H as it is and I should have the  Manager Email address and the other I,J,K,L should be moved next
0
DaveCommented:
Hi Sharath

Hows the baby?

Cheers

Dave

 
Sub Get_Users_Or_Contacts_Created_Between_Dates()
    Dim objRootdse, objUser
    Set objRootdse = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootdse.get("defaultNamingContext")
 
    strSheetName = "New NT Login"
 
    Set objSheet = Sheets(1)
 
    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
                Set objusermgr = GetObject("LDAP://" & objUser.manager)
                objSheet.Cells(intRow, "H").Value = Mid(Left(objUser.manager, InStr(objUser.manager, ",") - 1), 4)
                objSheet.Cells(intRow, "I").Value = objusermgr.get("mail")
            End If
            objSheet.Cells(intRow, "j").Value = objUser.Class
            objSheet.Cells(intRow, "K").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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bsharathAuthor Commented:
Hi Dave,

Ya Baby is fine...

When i run the script it asks for the date but no results show up...
0
bsharathAuthor Commented:
Hi Dave,

Ya Baby is fine...

When i run the script it asks for the date but no results show up...
0
bsharathAuthor Commented:
Dave your code works but it does not get the output to the sheet i am running from but gets it tyo a different sheet erasing the data in that sheet... :-(
0
DaveCommented:
Sharath,

My apologies, I didn't erverse my code testing
pls change this
Set objSheet = Sheets(1)
to
Set objSheet = Sheets(strSheetName)

There are some other tidy-ups we can do if the code is running slowly, force the user to enter a date format etc

Cheers

Dave

0
AngelizedCommented:
yep sorry for the confusion the IADS is not working for VBS
and VBA need a reference.
this should work.
Set objmanager = GetObject("LDAP://" & objUser.manager)
If Not IsEmpty(objmanager ) Then   objSheet.Cells(intRow, "I").Value = objmanager .Get("mail")

0
bsharathAuthor Commented:
Thank U Dave...
Thank you all for the help worked fine now....
0
bsharathAuthor Commented:
Thank U Dave...
Thank you all for the help worked fine now....
0
DaveCommented:
Thanks for the grade Sharath

Let me know if you want me to improve the  speed of the data population into Excel

Cheers

Dave
0
bsharathAuthor Commented:
Yes Dave if thats not going to take a long time for you...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming Languages-Other

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.