Export Active Directory Users to Excel Worksheet

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Export Active Directory Users to Excel Worksheet

Logged in as: Guest

arrSession:exec spGetSession 2,16,29830

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Export Active Directory Users to Excel Worksheet
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1] 2 3 next > >>

Message

<< Older Topic Newer Topic >>

Export Active Directory Users to Excel Worksheet - 1/12/2006 9:32:46 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

This script when run will export every "user" object in Active Directory and put into an Excel Spreadsheet. This will also include any and all SMTP alisas' (up to 20), that an account has.

Hope this might come in handy for someone.

UPDATED 3/7/2006 (please re-copy and paste if you use this already) I had a small error in script which wasn't getting the email address property reported on the one that's displayed on the "General" tab in ADUC (it showed up in excel as blank). Please note, there are 2 different locations for email, 1 on the General TAB in ADUC and another on the Email Addresses tab. (the one that was reporting blank was the one on the "General" tab.

-Eric

PS - I've posted the "write back" version of this script on another reply post.

If ObjMember.Class = "user" Then ' if not User object, move on. 
x = x +1 ' counter used to increment the cells in Excel

objwb.Cells(x, 1).Value = objMember.Class 
  ' I set AD properties to variables so if needed you could do Null checks or add if/then's to this code 
  ' this was done so the script could be modified easier. 
SamAccountName = ObjMember.samAccountName 
Cn = ObjMember.CN 
FirstName = objMember.GivenName 
LastName = objMember.sn 
initials = objMember.initials 
Descrip = objMember.description 
Office = objMember.physicalDeliveryOfficeName 
Telephone = objMember.telephonenumber 
EmailAddr = objMember.mail 
WebPage = objMember.wwwHomePage 
Addr1 = objMember.streetAddress 
City = objMember.l 
State = objMember.st 
ZipCode = objMember.postalCode 
Title = ObjMember.Title 
Department = objMember.Department 
Company = objMember.Company 
Manager = ObjMember.Manager 
Profile = objMember.profilePath 
LoginScript = objMember.scriptpath 
HomeDirectory = ObjMember.HomeDirectory 
HomeDrive = ObjMember.homeDrive 
AdsPath = Objmember.Adspath 
LastLogin = objMember.LastLogin

zz = 1 ' Counter for array of 2ndary email addresses 
For each email in ObjMember.proxyAddresses 
   If Left (email,5) = "SMTP:" Then 
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary 
   ElseIf Left (email,5) = "smtp:" Then 
      Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array. 
      zz = zz + 1 
   End If 
Next 
' Write the values to Excel, using the X counter to increment the rows.

objwb.Cells(x, 2).Value = SamAccountName 
objwb.Cells(x, 3).Value = CN 
objwb.Cells(x, 4).Value = FirstName 
objwb.Cells(x, 5).Value = LastName 
objwb.Cells(x, 6).Value = Initials 
objwb.Cells(x, 7).Value = Descrip 
objwb.Cells(x, 8).Value = Office 
objwb.Cells(x, 9).Value = Telephone 
objwb.Cells(x, 10).Value = EmailAddr
objwb.Cells(x, 11).Value = WebPage 
objwb.Cells(x, 12).Value = Addr1 
objwb.Cells(x, 13).Value = City 
objwb.Cells(x, 14).Value = State 
objwb.Cells(x, 15).Value = ZipCode 
objwb.Cells(x, 16).Value = Title 
objwb.Cells(x, 17).Value = Department 
objwb.Cells(x, 18).Value = Company 
objwb.Cells(x, 19).Value = Manager 
objwb.Cells(x, 20).Value = Profile 
objwb.Cells(x, 21).Value = LoginScript 
objwb.Cells(x, 22).Value = HomeDirectory 
objwb.Cells(x, 23).Value = HomeDrive 
objwb.Cells(x, 24).Value = Adspath 
objwb.Cells(x, 25).Value = LastLogin 
objwb.Cells(x,26).Value = Primary

' Write out the Array for the 2ndary email addresses. 
For ll = 1 To 20 
objwb.Cells(x,26+ll).Value = Secondary(ll) 
Next 
' Blank out Variables in case the next object doesn't have a value for the property 
SamAccountName = "-" 
Cn = "-" 
FirstName = "-" 
LastName = "-" 
initials = "-" 
Descrip = "-" 
Office = "-" 
Telephone = "-" 
EmailAddr = "-" 
WebPage = "-" 
Addr1 = "-" 
City = "-" 
State = "-" 
ZipCode = "-" 
Title = "-" 
Department = "-" 
Company = "-" 
Manager = "-" 
Profile = "-" 
LoginScript = "-" 
HomeDirectory = "-" 
HomeDrive = "-" 
Primary = "-" 
For ll = 1 To 20 
Secondary(ll) = "" 
Next 
  End If 
  
  ' If the AD enumeration runs into an OU object, call the Sub again to itinerate 
  
  If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then 
      enumMembers (objMember) 
  End If 
Next 
End Sub 
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row 
Set objExcel = CreateObject("Excel.Application") 
Set objwb = objExcel.Workbooks.Add 
Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName) 
Objwb.Name = "Active Directory Users" ' name the sheet 
objwb.Activate 
objExcel.Visible = True 
objwb.Cells(1, 2).Value = "SamAccountName" 
objwb.Cells(1, 3).Value = "CN" 
objwb.Cells(1, 4).Value = "FirstName" 
objwb.Cells(1, 5).Value = "LastName" 
objwb.Cells(1, 6).Value = "Initials" 
objwb.Cells(1, 7).Value = "Descrip" 
objwb.Cells(1, 8).Value = "Office" 
objwb.Cells(1, 9).Value = "Telephone" 
objwb.Cells(1, 10).Value = "Email" 
objwb.Cells(1, 11).Value = "WebPage" 
objwb.Cells(1, 12).Value = "Addr1" 
objwb.Cells(1, 13).Value = "City" 
objwb.Cells(1, 14).Value = "State" 
objwb.Cells(1, 15).Value = "ZipCode" 
objwb.Cells(1, 16).Value = "Title" 
objwb.Cells(1, 17).Value = "Department" 
objwb.Cells(1, 18).Value = "Company" 
objwb.Cells(1, 19).Value = "Manager" 
objwb.Cells(1, 20).Value = "Profile" 
objwb.Cells(1, 21).Value = "LoginScript" 
objwb.Cells(1, 22).Value = "HomeDirectory" 
objwb.Cells(1, 23).Value = "HomeDrive" 
objwb.Cells(1, 24).Value = "Adspath" 
objwb.Cells(1, 25).Value = "LastLogin" 
objwb.Cells(1, 26).Value = "Primary SMTP" 
End Sub 
MsgBox "Done" ' show that script is complete

< Message edited by edavis6678 -- 3/7/2006 7:26:39 AM >

Revisions: 7 | Post #: 1

RE: Export Active Directory Users to Excel Worksheet - 1/12/2006 3:33:51 PM

kirrilian

Posts: 628
Score: 3
Joined: 3/15/2005
From:
Status: offline

have you tried this script on an AD domain that has more than 1000 users?

i have run into this problem before and know how to get around it, just wondering if yours is able to or not.

_____________________________

Have you searched here ?
VBScript Fundamentals
My Site

(in reply to edavis6678)

Post #: 2

RE: Export Active Directory Users to Excel Worksheet - 1/13/2006 11:05:33 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

I haven't run it with over 1K users, but yes, it will not work unless you use ADO and LDAP query

(in reply to kirrilian)

Post #: 3

RE: Export Active Directory Users to Excel Worksheet - 3/7/2006 12:38:08 AM

ronny

Posts: 2
Score: 0
Joined: 3/7/2006
Status: offline

Hi,

The Script is very usefull! thanks.

Could you post the code to write back to AD as well?

When it writes back to the Active Directory, does it write back every cell in the excel sheet, or only the updated fields?

Thanks!

Rgds,
Ronny

(in reply to edavis6678)

Post #: 4

RE: Export Active Directory Users to Excel Worksheet - 3/7/2006 7:41:31 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

Ok...here's the script for writing back to AD. (you MUST use my original extract script for this to work). -careful with this one, please read script notes in beginning of file.

I've spend an hour or so cleaning it up and wrote in some logging. (didn't have it before, and now I think better). Also, in my original script I just re-commited all AD values, (even if just 1 property changed), but now this script will ONLY change values to those that changed, (and log it too).

I'm really glad to see that this script was helpful to you. (and hopefully this write-back will be more helpful too).

Please let me know your feedback and how it works for you.

-Eric

' WRITE AD Properties from EXCEL Spreadsheet v1
' Written By:  Eric Davis  (edavis6678@yahoo.com)
' Date: 3/7/2006
' PLEASE NOTE:  This will ONLY work if you use my latest "extract" from AD script (posted above - and it was recently updated).  (since the colummns need to be in correct spot)
' DISCLAIMER : WARNING!!!  THIS SCRIPT WRITES AND CHANGES DATA TO ACTIVE DIRECTORY!
' I WILL AND CAN NOT BE RESPONSIBLE IF THIS SCREWS UP YOUR DIRECTORY!  USE AT YOUR OWN RISK!!!
' (with that being said)
' I have done LOTS of testing on this script and I run it all the time at my company, but forewarned, 
' PLEASE use logging mode first before doing anything!
' Script Notes:
' This script will NOT change AD properties for the following fields: 
' SamAccountName, CN, Manager, AdsPath, LastLogin, Primary SMTP, or any additional email aliases.
' Be sure to change the 4 variables below to suit your needs.  
' boolCommitFlag must be set to 1 in order to actually write to AD. (this good for testing) - Default is set to LOG only
' Other Notes:
' If ANY row value that has the Adspath value blank, script will quit.
' The script will not change row 1 -- reserved for header row
' Script will ONLY change/commit values to AD that are different from spreadsheet - it IS case sensitive.  (and it will log change to txt file)
' Enjoy!
' START SCRIPT
Option Explicit
On Error Resume Next ' Didn't have time to write extensive AD error checking when reading properties, so I set this on.  The typical error occurred
    ' when trying to read an AD property that doesn't exist.  Sometime I'll clean this up, but for now, I put resume next on.
Dim ObjUser, PathofFile, shtName, x, ObjE, ObjWB, OutFile, PathofLogFile
Dim FirstName, ADFirstName, LastName, ADLastName
Dim Initials, ADInitials, Descrip, ADDescrip
Dim Office, ADOffice, Telephone, ADTelephone
Dim Email, ADEmail, WebPage, ADWebPage
Dim Addr1, ADAddr1, City, ADCity
Dim State, ADState, ZipCode, ADZipCode
Dim Title, ADTitle, Department, ADDepartment
Dim Company, ADCompany, Profile, ADProfile
Dim LoginScript, ADLoginScript, HomeDirectory, ADHomeDirectory, HomeDrive, ADHomeDrive
Dim ret, boolCommitFlag, fso, ObjExcel, wb, ReadLine, boolWriteNeeded
Set fso = CreateObject("Scripting.FileSystemObject")
'###########################
'CHANGE THIS VARIABLES HERE 
'###########################
PathofFile = "C:\ADoutput.xls"
PathofLogFile = "C:\ADChange_log.txt"
shtName = "Active Directory Users" ' sheet names must match.  (if you used my script before, it will work)
boolCommitFlag = "0" ' IMPORTANT - CHANGE to 1 or it will only LOG what will be changed.
'###########################
'###########################
If boolCommitFlag = 0 Then
ret = MsgBox("Click OK to TEST Export from : " & PathofFile & vbcrlf & vbcrlf & "LOGFILE: " & PathofLogFile,1,"Welcome to AD Import (LOGGING ONLY)")
 If ret <> 1 Then WScript.quit
Elseif boolCommitFlag = 1 Then
ret = MsgBox("Click OK to WRITE changes from Import file : " & PathofFile & vbcrlf & vbcrlf & "LOGFILE: " & PathofLogFile,1,"Welcome to AD Import (WRITE MODE)")
End If
Err.clear
Set OutFile = fso.openTextFile(PathofLogFile, 8, True, -2) ' will APPEND to EXISTING FILE
If Err.Number <> 0 Then
MsgBox "ERROR in OPENING LOG FILE (It's probably open) -  STOPPING SCRIPT",48, "NOPE - Ain't going to do it"
WScript.Quit
End If

Call ExcelSetup() ' Sub to set-up Excel
' Begin header of log file
If boolCommitFlag = 0 Then
OutFile.Write vbcrlf & "STARTING LOG ONLY On " & Time() & vbcrlf
Elseif boolCommitFlag = 1 then
OutFile.Write vbcrlf & "STARTING AD WRITE On " & Time() & vbcrlf
End If
x = 1 ' Set to 1 so to not try the header row
readLine = ObjWB.WorkSheets(shtName).Cells.Item(x,24).Value ' Read Header so it ain't nothing to start
Do While ReadLine <> ""
x = x + 1
readLine = ObjWB.WorkSheets(shtName).Cells.Item(x,24).Value ' Read the ADSPath
If ReadLine = "" Then Exit Do ' if blank, exit
Set objUser = GetObject (ReadLine) ' Bind to AD Object

' Do Comparisons on all values and PUT values
FirstName = ObjWB.WorkSheets(shtName).Cells.Item(x,4).Value
ADFirstName = ObjUser.givenname
If FirstName <> ADFirstName Then 
 Call LogFileWrite("FirstName (givenname)", FirstName, ADFirstName)
 If FirstName <> "" then ObjUser.Put "givenname", FirstName
End If

LastName = ObjWB.WorkSheets(shtName).Cells.Item(x,5).Value
ADLastName = ObjUser.sn
If LastName <> ADLastName Then
 Call LogFileWrite("LastName (sn)", LastName, ADLastName)
 If LastName <> "" Then ObjUser.Put "sn", LastName
End If

Initials = ObjWB.WorkSheets(shtName).Cells.Item(x,6).Value
ADInitials = ObjUser.initials
If Initials <> ADInitials Then
 Call LogFileWrite("Initials (initials)", Initials, ADInitials)
 If Initials <> "" Then ObjUser.Put "initials", Initials
End If

Descrip = ObjWB.WorkSheets(shtName).Cells.Item(x,7).Value
ADDescrip = ObjUser.Description
If Descrip <> ADDescrip Then
 Call LogFileWrite("Description (description)", Descrip, ADDescrip)
 If Descrip <> "" Then ObjUser.Put "description", Descrip
End If

Office = ObjWB.WorkSheets(shtName).Cells.Item(x,8).Value
ADOffice = ObjUser.physicalDeliveryOfficeName
If Office <> ADOffice Then
 Call LogFileWrite("Office (office)", Office, ADOffice)
 If Office <> "" Then ObjUser.Put "physicalDeliveryOfficeName", Office
End If
Telephone = ObjWB.WorkSheets(shtName).Cells.Item(x,9).Value
ADTelephone = ObjUser.telephoneNumber
If Telephone <> ADTelephone Then
 Call LogFileWrite("Telephone (telephonenumber)", Telephone, ADTelephone)
 If Telephone <> "" Then ObjUser.Put "telephoneNumber", Telephone
End If

Email = cstr(ObjWB.WorkSheets(shtName).Cells.Item(x,10).Value)
ADEmail = ObjUser.mail
If Email <> ADEmail Then
 Call LogFileWrite("Email (mail)", Email, ADEmail)
 If Email <> "" Then ObjUser.Put "mail", Email
End If

WebPage = ObjWB.WorkSheets(shtName).Cells.Item(x,11).Value
ADWebPage = ObjUser.HomePage
If WebPage <> ADWebPage Then
 Call LogFileWrite("WebPage (homepage)", WebPage, ADWebPage)
 If WebPage <> "" Then ObjUser.Put "HomePage", WebPage
End If

Addr1 = ObjWB.WorkSheets(shtName).Cells.Item(x,12).Value
ADAddr1 = ObjUser.streetAddress
If Addr1 <> ADAddr1 Then 
 Call LogFileWrite("Addr1 (streetAddress)", Addr1, ADAddr1)
 If Addr1 <> "" Then ObjUser.Put "streetAddress", Addr1
End If
City = ObjWB.WorkSheets(shtName).Cells.Item(x,13).Value
ADCity = ObjUser.l
If City <> ADCity Then 
 Call LogFileWrite("City (l)", City, ADCity)
 If City <> "" Then ObjUser.Put "l", City
End If

State = ObjWB.WorkSheets(shtName).Cells.Item(x,14).Value
ADState = ObjUser.st
If State <> ADState Then 
 Call LogFileWrite("State (st)", State, ADState)
 If State <> "" Then ObjUser.Put "st", State
End If

ZipCode = FormatNumber(ObjWB.WorkSheets(shtName).Cells.Item(x,15).Value,0,0,0,0)
ADZipCode = ObjUser.Postalcode
If ZipCode <> ADZipCode Then 
 Call LogFileWrite("ZipCode (postalcode)", ZipCode, ADZipeCode)
 If ZipCode <> "" Then ObjUser.Put "postalcode", ZipCode
End If

Title = ObjWB.WorkSheets(shtName).Cells.Item(x,16).Value
ADTitle = ObjUser.Title
If Title <> ADTitle Then 
 Call LogFileWrite("Title (Title)", Title, ADTitle)
 If Title <> "" Then ObjUser.Put "Title", Title
End If

Department = ObjWB.WorkSheets(shtName).Cells.Item(x,17).Value
ADDepartment = ObjUser.Department
If Department <> ADDepartment Then 
 Call LogFileWrite("Department (Department)", Department, ADDepartment)
 If Department <> "" Then ObjUser.Put "Department", Department
End If
Company = ObjWB.WorkSheets(shtName).Cells.Item(x,18).Value
ADCompany = ObjUser.Company
If Company <> ADCompany Then 
 Call LogFileWrite("Company (Company)", Company, ADCompany)
 If Company <> "" Then ObjUser.Put "Company", Company
End If

Profile = ObjWB.WorkSheets(shtName).Cells.Item(x,20).Value
ADProfile = ObjUser.ProfilePath
If Profile <> ADProfile Then 
 Call LogFileWrite("Profile (Profilepath)", Profile, ADProfile)
 If Profile <> "" Then ObjUser.Put "Profilepath", Profile
End If

LoginScript = ObjWB.WorkSheets(shtName).Cells.Item(x,21).Value
ADLoginScript = ObjUser.ScriptPath
If LoginScript <> ADLoginScript Then 
 Call LogFileWrite("LoginScript (Scriptpath)", LoginScript, ADLoginScript)
 If LoginScript <> "" Then ObjUser.Put "ScriptPath", LoginScript
End If

HomeDirectory = ObjWB.WorkSheets(shtName).Cells.Item(x,22).Value
ADHomeDirectory = ObjUser.HomeDirectory
If HomeDirectory <> ADHomeDirectory Then 
 Call LogFileWrite("HomeDirectory (HomeDirectory)", HomeDirectory, ADHomeDirectory)
 If LoginScript <> "" Then ObjUser.Put "HomeDirectory", HomeDirectory
End If

HomeDrive = ObjWB.WorkSheets(shtName).Cells.Item(x,23).Value
ADHomeDrive = ObjUser.HomeDrive
If HomeDrive <> ADHomeDrive Then 
 Call LogFileWrite("HomeDrive (HomeDrive)", HomeDrive, ADHomeDrive)
 If HomeDrive <> "" Then ObjUser.Put "HomeDrive", HomeDrive
End If

If boolCommitFlag = 1 and boolWriteNeeded = 1 then
 ObjUser.SetInfo
End If

Set ObjUser = Nothing
FirstName = ""
ADFirstName = ""
LastName = ""
ADLastName = ""
Initials = ""
ADInitials = ""
Descrip = ""
ADDescrip = ""
Office = ""
ADOffice = ""
Telephone = ""
ADTelephone = ""
Email = ""
ADEmail = ""
WebPage = ""
ADWebPage = ""
Addr1 = ""
ADAddr1 = ""
City = ""
ADCity = ""
State = ""
ADState = ""
ZipCode = ""
ADZipCode = ""
Title = ""
ADTitle = ""
Department = ""
ADDepartment = ""
Company = ""
ADCompany = ""
Profile = ""
ADProfile = ""
LoginScript = ""
ADLoginScript = ""
HomeDirectory = ""
ADHomeDirectory = ""
HomeDrive = ""
ADHomeDrive = ""
boolWriteNeeded = 0
Loop
ObjWB.Close
If boolCommitFlag = 0 Then
OutFile.Write "Completed LOG ONLY On " & Time() & Date() & vbcrlf
Elseif boolCommitFlag = 1 then
OutFile.Write "Completed AD WRITE On " & Time() & Date() & vbcrlf
End If
OutFile.Close
Set ObjExcel = Nothing
Set fso = Nothing
MsgBox "DONE"

Sub LogFileWrite(FieldChanged, NewValue,ADValue)
boolWriteNeeded = 1
If ADValue = "" Then ADValue = "WasNothingBefore"
If NewValue = "" Then NewValue = "WillBeBlankNow"
OutFile.Writeline Date() & vbTab & ReadLine & vbTab & "CHANGED" & vbTab & FieldChanged & vbTab & ADValue & vbTab & NewValue
'WScript.echo Date() & vbTab & ReadLine & vbTab & "CHANGED" & vbTab & FieldChanged & vbTab & ADValue & vbTab & NewValue  '(Put this line in, if you want cscript output)
End Sub

Sub ExcelSetup()
Set objExcel = CreateObject("Excel.Application")
   Set wb = objExcel.WorkBooks
   Set objwb = wb.Open (PathofFile)
   objwb.Activate
End Sub

(in reply to ronny)

Post #: 5

RE: Export Active Directory Users to Excel Worksheet - 3/27/2006 10:21:37 PM

centrino

Posts: 16
Score: 0
Joined: 9/4/2005
Status: offline

IN Line 126 [Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName)] I have a "Subscript out of range" error. Any ideas?

(in reply to edavis6678)

Post #: 6

RE: Export Active Directory Users to Excel Worksheet - 3/28/2006 3:47:38 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

I'm not a pro of the excel object model, so my excel creation portion is probably prone to an error here or there.. I just ran the script from copying/pasting from forum to be sure it was copied up correctly and I didnt' receive error. (seeing that I can't recreate, couple things come to mind.)

The script calls a sub to create the workbook, be sure line 7 is exactly as it is: Call ExcelSetup("Sheet1")

This sub assumes that when you open Excel you have a default worksheet named, "Sheet1". Verify this is the case for you by opening Excel and look at the sheet names.

The only thing thing that comes to mind is that the Excel object on your computer is not being created properly. Can you try running this on another computer?

When you run the script and it gives an error, can you check your "task mananger" and see if EXCEL.EXE is running?

(in reply to centrino)

Post #: 7

RE: Export Active Directory Users to Excel Worksheet - 5/9/2006 10:50:23 PM

Octal2001

Posts: 8
Score: 0
Joined: 4/12/2006
Status: offline

Nice Scripts, I have an question, i would like to export the ccmail field from AD do you know the object code i need to add to do this?

Thanks for any feed back.

(in reply to edavis6678)

Post #: 8

RE: Export Active Directory Users to Excel Worksheet - 5/10/2006 3:30:16 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

I'm not familar with CCmail...can there only be 1 CCMAIL address? or multiples

I can give you a quick fix to this, but I'm thinking of adding some more fields per other users' requests.

Give me a day or so.

ps - if you know VB, this is how i got the properties

(in reply to Octal2001)

Revisions: 1 | Post #: 9

RE: Export Active Directory Users to Excel Worksheet - 5/10/2006 9:22:08 PM

Octal2001

Posts: 8
Score: 0
Joined: 4/12/2006
Status: offline

Thanks for the code i'll test it now.there can only be one ccmail for each user account. (i Believe!!!)

(in reply to edavis6678)

Post #: 10

RE: Export Active Directory Users to Excel Worksheet - 5/19/2006 6:33:47 AM

kirrilian

Posts: 628
Score: 3
Joined: 3/15/2005
From:
Status: offline

I've made some small formatting changes to make it easier to read. I added an autosave at the end as well.

Dim ObjWb 
Dim ObjExcel 
Dim x, zz 
Set objRoot = GetObject("LDAP://RootDSE") 
strDNC = objRoot.Get("DefaultNamingContext") 
Set objDomain = GetObject("LDAP://" & strDNC) ' Bind to the top of the Domain using LDAP using ROotDSE 
Call ExcelSetup("Sheet1") ' Sub to make Excel Document 
x = 1 
Call enummembers(objDomain) 
Sub enumMembers(objDomain) 
   On Error Resume Next 
   Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's 
   For Each objMember In objDomain ' go through the collection     
       If ObjMember.Class = "user" Then ' if not User object, move on. 
           x = x +1 ' counter used to increment the cells in Excel 
           
             objwb.Cells(x, 1).Value = objMember.Class 
             ' I set AD properties to variables so if needed you could do Null checks or add if/then's to this code 
             ' this was done so the script could be modified easier. 
           SamAccountName = ObjMember.samAccountName 
           Cn = ObjMember.CN 
           FirstName = objMember.GivenName 
           LastName = objMember.sn 
           initials = objMember.initials 
           Descrip = objMember.description 
           Office = objMember.physicalDeliveryOfficeName 
           Telephone = objMember.telephonenumber 
           EmailAddr = objMember.mail 
           WebPage = objMember.wwwHomePage 
           Addr1 = objMember.streetAddress 
           City = objMember.l 
           State = objMember.st 
           ZipCode = objMember.postalCode 
           Title = ObjMember.Title 
           Department = objMember.Department 
           Company = objMember.Company 
           Manager = ObjMember.Manager 
           Profile = objMember.profilePath 
           LoginScript = objMember.scriptpath 
           HomeDirectory = ObjMember.HomeDirectory 
           HomeDrive = ObjMember.homeDrive 
           AdsPath = Objmember.Adspath 
           LastLogin = objMember.LastLogin 
           
           zz = 1 ' Counter for array of 2ndary email addresses 
           For Each email in ObjMember.proxyAddresses 
              If Left (email,5) = "SMTP:" Then 
           Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary 
              Elseif Left (email,5) = "smtp:" Then 
                 Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array. 
                 zz = zz + 1 
              End If 
           Next 
           ' Write the values to Excel, using the X counter to increment the rows. 
           
           objwb.Cells(x, 2).Value = SamAccountName 
           objwb.Cells(x, 3).Value = CN 
           objwb.Cells(x, 4).Value = FirstName 
           objwb.Cells(x, 5).Value = LastName 
           objwb.Cells(x, 6).Value = Initials 
           objwb.Cells(x, 7).Value = Descrip 
           objwb.Cells(x, 8).Value = Office 
           objwb.Cells(x, 9).Value = Telephone 
           objwb.Cells(x, 10).Value = EmailAddr
           objwb.Cells(x, 11).Value = WebPage 
           objwb.Cells(x, 12).Value = Addr1 
           objwb.Cells(x, 13).Value = City 
           objwb.Cells(x, 14).Value = State 
           objwb.Cells(x, 15).Value = ZipCode 
           objwb.Cells(x, 16).Value = Title 
           objwb.Cells(x, 17).Value = Department 
           objwb.Cells(x, 18).Value = Company 
           objwb.Cells(x, 19).Value = Manager 
           objwb.Cells(x, 20).Value = Profile 
           objwb.Cells(x, 21).Value = LoginScript 
           objwb.Cells(x, 22).Value = HomeDirectory 
           objwb.Cells(x, 23).Value = HomeDrive 
           objwb.Cells(x, 24).Value = Adspath 
           objwb.Cells(x, 25).Value = LastLogin 
           objwb.Cells(x,26).Value = Primary 
           
           ' Write out the Array for the 2ndary email addresses. 
           For ll = 1 To 20 
               objwb.Cells(x,26+ll).Value = Secondary(ll) 
           Next 
           ' Blank out Variables in case the next object doesn't have a value for the property 
           SamAccountName = "-" 
           Cn = "-" 
           FirstName = "-" 
           LastName = "-" 
           initials = "-" 
           Descrip = "-" 
           Office = "-" 
           Telephone = "-" 
           EmailAddr = "-" 
           WebPage = "-" 
           Addr1 = "-" 
           City = "-" 
           State = "-" 
           ZipCode = "-" 
           Title = "-" 
           Department = "-" 
           Company = "-" 
           Manager = "-" 
           Profile = "-" 
           LoginScript = "-" 
           HomeDirectory = "-" 
           HomeDrive = "-" 
           Primary = "-" 
           For ll = 1 To 20 
               Secondary(ll) = "" 
           Next 
       End If 
             
             ' If the AD enumeration runs into an OU object, call the Sub again to itinerate 
             
       If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then 
           enumMembers (objMember) 
       End If 
   Next 
End Sub 
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row 
   Set ObjExcel = CreateObject("Excel.Application") 
   Set objwb = objExcel.Workbooks.Add 
   Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName) 
   Objwb.Name = "Active Directory Users" ' name the sheet 
   objwb.Activate 
   ObjExcel.Visible = True 
   objwb.Cells(1, 2).Value = "SamAccountName" 
   objwb.Cells(1, 3).Value = "CN" 
   objwb.Cells(1, 4).Value = "FirstName" 
   objwb.Cells(1, 5).Value = "LastName" 
   objwb.Cells(1, 6).Value = "Initials" 
   objwb.Cells(1, 7).Value = "Description" 
   objwb.Cells(1, 8).Value = "Office" 
   objwb.Cells(1, 9).Value = "Telephone" 
   objwb.Cells(1, 10).Value = "Email" 
   objwb.Cells(1, 11).Value = "WebPage" 
   objwb.Cells(1, 12).Value = "Addr1" 
   objwb.Cells(1, 13).Value = "City" 
   objwb.Cells(1, 14).Value = "State" 
   objwb.Cells(1, 15).Value = "ZipCode" 
   objwb.Cells(1, 16).Value = "Title" 
   objwb.Cells(1, 17).Value = "Department" 
   objwb.Cells(1, 18).Value = "Company" 
   objwb.Cells(1, 19).Value = "Manager" 
   objwb.Cells(1, 20).Value = "Profile" 
   objwb.Cells(1, 21).Value = "LoginScript" 
   objwb.Cells(1, 22).Value = "HomeDirectory" 
   objwb.Cells(1, 23).Value = "HomeDrive" 
   objwb.Cells(1, 24).Value = "Adspath" 
   objwb.Cells(1, 25).Value = "LastLogin" 
   objwb.Cells(1, 26).Value = "Primary SMTP"
   'formatting for header 
   Set objRange = objExcel.Range("A1","Z1")
   objRange.Interior.ColorIndex = 33
   objRange.Font.Bold = True
   objRange.Font.Underline = True
End Sub 
'autofit the output
Set objRange = objwb.UsedRange
objRange.EntireColumn.Autofit()
ObjExcel.Save("ADoutput.xls")
MsgBox "Done" ' show that script is complete

_____________________________

Have you searched here ?
VBScript Fundamentals
My Site

(in reply to edavis6678)

Post #: 11

RE: Export Active Directory Users to Excel Worksheet - 5/19/2006 6:49:06 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

oh..neat...i just tried it..very nice.

The clean-up is nice too. I've been so slammed here at work, but I still have the code, (need to post it), which adds CCMAIL. I'm also thinking of expanding the output for every AD property, and eventually also support over 1K users. (the query just has to use a different provider). Also want to add an option for computers too. (which I already have written, again not cleaned up for publishing though). (I even have another that does for local accounts - add and list, (a need that arose from creating a non-domain FTP server). I'll post that sometime too :) (I know there are many free-ware scripts already written for this, but I think it's more fun to do it yourself)

Cheers

(in reply to kirrilian)

Post #: 12

RE: Export Active Directory Users to Excel Worksheet - 5/22/2006 4:31:37 AM

kirrilian

Posts: 628
Score: 3
Joined: 3/15/2005
From:
Status: offline

quote:

ORIGINAL: edavis6678

oh..neat...i just tried it..very nice.

Thanks, I got most of the formatting code from the script center. I've been wanting to play with the excel object and had a little time on Friday. :)

quote:

The clean-up is nice too. I've been so slammed here at work, but I still have the code, (need to post it), which adds CCMAIL. I'm also thinking of expanding the output for every AD property, and eventually also support over 1K users. (the query just has to use a different provider).

Whenever you want to work on that I'd be interested in helping, although I can already see one problem. We have a custom AD schema here and a generic script that pulls all attributes might not work, so maybe pulling the schema first then enumerating all the attributes that way.

quote:

Also want to add an option for computers too. (which I already have written, again not cleaned up for publishing though). (I even have another that does for local accounts - add and list, (a need that arose from creating a non-domain FTP server). I'll post that sometime too :) (I know there are many free-ware scripts already written for this, but I think it's more fun to do it yourself)

Again, I'd be happy to help implement doing computers rather than users as well.

Thanks for the excellent script!

_____________________________

Have you searched here ?
VBScript Fundamentals
My Site

(in reply to edavis6678)

Post #: 13

RE: Export Active Directory Users to Excel Worksheet - 5/26/2006 5:26:16 AM

tcole33

Posts: 6
Score: 0
Joined: 5/26/2006
Status: offline

Great job on the script. I was wondering if someone could help me modify this (your initial script).....
I would like it to return all of the users group memberships instead of the ADSPath.... for example

John    Doe
                        Domain User
                        Accounting
                        IT User
Jane Doe
                      Domain Users
                      Internet Access Group
                      Domain Administrator
etc......

I am trying to comply with SARBOX and this script is EXACTLY what I was looking for ... only I need the group memberships listed for each user......
Any help is greatly appreciated.

Here is the scirpt that you had posted and I had been modifying.......

Sub enumMembers(objDomain)
On Error Resume Next
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's
For Each objMember In objDomain ' go through the collection
If ObjMember.Class = "user" Then ' if not User object, move on.
x = x + 1 ' counter used to increment the cells in Excel

FirstName = objMember.GivenName
LastName = objMember.sn
Manager = ObjMember.Manager
AdsPath = Objmember.Adspath
zz = 1 ' Counter for array of 2ndary email addresses
For each email in ObjMember.proxyAddresses
If Left (email,5) = "SMTP:" Then
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary
ElseIf Left (email,5) = "smtp:" Then
    Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array.
     zz = zz + 1
End If
Next
' Write the values to Excel, using the X counter to increment the rows.
objwb.Cells(x, 1).Value = FirstName
objwb.Cells(x, 2).Value = LastName
objwb.Cells(x, 3).Value = Manager
objwb.Cells(x, 4).Value = ADSPath
' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20
objwb.Cells(x,26+ll).Value = Secondary(ll)
Next
' Blank out Variables in case the next object doesn't have a value for the property
FirstName = "-"
LastName = "-"
Manager = "-"
For ll = 1 To 20
Secondary(ll) = ""
Next
End If

' If the AD enumeration runs into an OU object, call the Sub again to itinerate

If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then
     enumMembers (objMember)
End If
Next
End Sub
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row
Set objExcel = CreateObject("Excel.Application")
Set objwb = objExcel.Workbooks.Add
Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName)
Objwb.Name = "Active Directory Users" ' name the sheet
objwb.Activate
objExcel.Visible = True
objwb.Cells(1, 1).Value = "FirstName"
objwb.Cells(1, 2).Value = "LastName"
objwb.Cells(1, 3).Value = "Manager"
objwb.Cells(1, 4).Value = "Adspath"
End Sub
MsgBox "Done" ' show that script is complete

(in reply to kirrilian)

Post #: 14

RE: Export Active Directory Users to Excel Worksheet - 5/26/2006 5:48:17 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

Removed and reposted in better location

< Message edited by edavis6678 -- 5/30/2006 4:18:06 AM >

(in reply to tcole33)

Revisions: 2 | Post #: 15

RE: Export Active Directory Users to Excel Worksheet - 5/26/2006 11:18:48 AM

tcole33

Posts: 6
Score: 0
Joined: 5/26/2006
Status: offline

That was EXATLY what I was looking for! I can't thank you enough...... I wonder if I could get you to tell me 1 thing.... how would I add attributes from ad and include them into the database? I would like to pull the display name, group description, and manager attributes into the database as well if possible. That would give me everything I need.... Thanks again.... it has really helped me out.....

(in reply to edavis6678)

Post #: 16

RE: Export Active Directory Users to Excel Worksheet - 5/27/2006 8:03:20 AM

edavis6678

Posts: 121
Score: 0
Joined: 1/12/2006
Status: offline

Very nice to hear that this working for. It's nice to know that someone can find a script I find useful also useful.

As for other properties, it's pretty straight forward. Below are some common properties.

SamAccountName = ObjMember.samAccountName
Cn = ObjMember.CN
FirstName = objMember.GivenName
LastName = objMember.sn
initials = objMember.initials
Descrip = objMember.description
Office = objMember.physicalDeliveryOfficeName
Telephone = objMember.telephonenumber
EmailAddr = objMember.mail
WebPage = objMember.wwwHomePage
Addr1 = objMember.streetAddress
City = objMember.l
State = objMember.st
ZipCode = objMember.postalCode
Title = ObjMember.Title
Department = objMember.Department
Company = objMember.Company
Manager = ObjMember.Manager
Profile = objMember.profilePath
LoginScript = objMember.scriptpath
HomeDirectory = ObjMember.HomeDirectory
HomeDrive = ObjMember.homeDrive
AdsPath = Objmember.Adspath
LastLogin = objMember.LastLogin

Here is a link from MS on the rest of them: http://windowssdk.msdn.microsoft.com/library/default.asp?url=/library/en-us/ADSI/adsi/iadsuser.asp

Remember that some values are very long and some have values that don't insert well into Access unless you tweak them. (That's why i have the FixValue function in my script). Also, some values are COLLECTIONS, (so you have to write a routine to get it out).

I'm not on a domain atm, so I can't test these changes, if what I posted here doesn't work, let me know and I'll correct, but below is what you need to change.

If you want to change the properties, or add more, just simply add more colummns to your database table, set variables to the user object properties, then modify the INSERT command with the additional properties.

For example....

If you want to ADD another columm for Manager ADS path, modify the script this way: (RED notes new lines)

First, you must add a colummn to your table and name it, ManagerADSPath. Make it a MEMO type since it will return a very long value.

Next, add a variable named, ManagerADS = to the AD user object property. Shown below. (also note I purposely named it differently so you can see how the INSERT command works)

ADGroupName = Mid(FixValue(objADGroup.Name),4)
SamAccountName = FixValue(objMember.SamAccountName)
Department = FixValue(ObjMember.Department)
UserADSPath = FixValue(objMember.AdsPath)
ManagerADS = FixValue(objMember.Manager)
qryInsert = "INSERT INTO [" & dbTableName & "](ADGroupName, SamAccountName, Department,CN, UserAdsPath, ManagerADSPath) VALUES ('" & ADGroupName & "','" & SamAccountName & "','" & Department & "', '" & CN & "', '" & UserAdsPath & "', '" & ManagerADS & '")"
conn.Execute (qryInsert)

Just add more and more if you want, or change some of them with what you want.

Special note. Manager for a user object only returns an ADSPath.

Another thing you can do. Take the excel output from the original script and IMPORT it into Access, then join the tables VIA a key field. (like SamAccountName), and make your own report, query, etc....(you could also get the Display name of the manager, but simply buidling a query and linking ADSPATH)

Hope this makes sense

< Message edited by edavis6678 -- 5/27/2006 8:16:31 AM >

(in reply to tcole33)