Solved

Excel Code to get Data from Active directory.

Posted on 2008-10-20
14
2,151 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

0
Comment
Question by:bsharath
  • 8
  • 3
  • 2
  • +1
14 Comments
 
LVL 17

Expert Comment

by:ExcelGuide
ID: 22755929
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
 
LVL 3

Expert Comment

by:Angelized
ID: 22755995

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
 
LVL 11

Author Comment

by:bsharath
ID: 22756037
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
 
LVL 11

Author Comment

by:bsharath
ID: 22756039
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
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 22756043
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
 
LVL 11

Author Comment

by:bsharath
ID: 22756088
Hi Dave,

Ya Baby is fine...

When i run the script it asks for the date but no results show up...
0
 
LVL 11

Author Comment

by:bsharath
ID: 22756089
Hi Dave,

Ya Baby is fine...

When i run the script it asks for the date but no results show up...
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 11

Author Comment

by:bsharath
ID: 22756304
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
 
LVL 50

Expert Comment

by:Dave Brett
ID: 22756349
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
 
LVL 3

Expert Comment

by:Angelized
ID: 22756387
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
 
LVL 11

Author Comment

by:bsharath
ID: 22756401
Thank U Dave...
Thank you all for the help worked fine now....
0
 
LVL 11

Author Comment

by:bsharath
ID: 22756402
Thank U Dave...
Thank you all for the help worked fine now....
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 22756865
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
 
LVL 11

Author Comment

by:bsharath
ID: 22756891
Yes Dave if thats not going to take a long time for you...
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you haven’t already, I encourage you to read the first article (http://www.experts-exchange.com/articles/18680/An-Introduction-to-R-Programming-and-R-Studio.html) in my series to gain a basic foundation of R and R Studio.  You will also find the …
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now