Solved

Excel Code to get Data from Active directory.

Posted on 2008-10-20
14
2,160 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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

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

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Extract Unique List when in Two Columns in Excel 20 27
Excel Drop Down List 13 34
Formula Help 3 22
Formula help - MIN 5 12
The purpose of this article is to demonstrate how we can use conditional statements using Python.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

810 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