Solved

Excel Code to get Data from Active directory.

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

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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Hi Dave,

Ya Baby is fine...

When i run the script it asks for the date but no results show up...
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Thank U Dave...
Thank you all for the help worked fine now....
0
 
LVL 11

Author Comment

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

Expert Comment

by:Dave Brett
Comment Utility
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
Comment Utility
Yes Dave if thats not going to take a long time for you...
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

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 …
Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
The viewer will learn how to use the return statement in functions in C++. The video will also teach the user how to pass data to a function and have the function return data back for further processing.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

744 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

17 Experts available now in Live!

Get 1:1 Help Now