Question

Locked

Export Queried User Attributes in AD into Excel Spread Sheet.

By John.Key1 ·
Yes, I want to be able to export queried user attributes in AD into Excel spread sheet. What is the VBScripting code to extract information from all users within an OU? By information, I mean sAMAccountName, givenName, initials, sn, and etc...

In fact, I have a script that populates users into AD from an Excel file called "Users.xls". In essanse, I would like to do the exact opposite and pull all that information from AD and then put into Excel; any working ideas out there?

Here is the VBS code:
-------------------------
' ------------------------------------------------------'
' Version 1.2 - March 2008
' Any use/editing of this VBScript is authorized solely
' based that the maker/creater of this VBScript is not
' held accountable and/or obligated to any actions.
'
'
' NOTES: A few changes will need to be made to the code.
' 1.1 I plan to add the ability to create mailboxes.
' 1.2 I want to add option between Perm./Augmented User.
'
' CHANGE LOG:
' 2.1 Notes & Change Log section were added. - MARCH 2008
' 2.2 Declaired constants were added. - MARCH 2008
' 2.3 Constants were added to the codding. - MARCH 2008
'
' ------------------------------------------------------'

Option Explicit
Dim intRow
Dim objContainer, objExcel, objRootLDAP, objShell, objSpread, objUser
Dim strCN, strCompany, strDepart, strDName
Dim strDSN, strEmail, strExpire, strFirst, strIDEPI, strInital, strLast
Dim strOU, strSam, strSheet, strTitle, strUser

' ------------------------------------------------------'
' Declair Constants.
' ------------------------------------------------------'

Const strAddress = "<Street Address>"
Const strDescript = "<User Description>"
Const strOffSym = "<Office Title>"


' ------------------------------------------------------'
' Change OU string to match your OU.
' ------------------------------------------------------'

strOU = "OU=USERS,OU=<Company>,OU=<OU>,OU=<OU> ," ' Note the comma

' ------------------------------------------------------'
' Change Sheet string to match where you saved the Users.xls.
' ------------------------------------------------------'

strSheet = "C:\scripts\Users.xls"

' ------------------------------------------------------'
' Bind to Active Directory, Users container.
' ------------------------------------------------------'

Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))

' ------------------------------------------------------'
' Open the Excel spreadsheet
' ------------------------------------------------------'

Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 3 'Row 1 often contains headings

' ------------------------------------------------------'
' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
' ------------------------------------------------------'

Do Until objExcel.Cells(intRow,1).Value = ""
strLast = Trim(objExcel.Cells(intRow, 1).Value)
strFirst = Trim(objExcel.Cells(intRow, 2).Value)
strInital = Trim(objExcel.Cells(intRow, 3).Value)
strEmail = Trim(objExcel.Cells(intRow, 10).Value)
strTitle = Trim(objExcel.Cells(intRow, 11).Value)
strDepart = Trim(objExcel.Cells(intRow, 12).Value)
strDSN = Trim(objExcel.Cells(intRow, 13).Value)
strCompany = Trim(objExcel.Cells(intRow, 14).Value)
strExpire = Trim(objExcel.Cells(intRow, 16).Value)
strSam = Trim(objExcel.Cells(intRow, 19).Value)
strCN = Trim(objExcel.Cells(intRow, 20).Value)
strDName = Trim(objExcel.Cells(intRow, 21).Value)

' ------------------------------------------------------'
' Build the actual User from data in strSheet.
' ------------------------------------------------------'

Set objUser = objContainer.Create("User", "cn=" & strCN)
objUser.sAMAccountName = strSam
objUser.givenName = strFirst
objUser.initials = strInital
objUser.sn = strLast
objUser.streetAddress = strAddress
objUser.physicalDeliveryOfficeName = strOffSym
objUser.mail = strEmail
objUser.telephoneNumber = strDSN
objUser.description = strDescript
objUser.displayName = strDName
objUser.title = strTitle
objUser.department = strDepart
objUser.company = strCompany
objUser.AccountExpirationDate = strExpire
objUser.Put "pwdLastSet", CLng(-1)
objUser.SetInfo

intRow = intRow + 1
Loop
objExcel.Quit

' ------------------------------------------------------'
' Clean up.
' ------------------------------------------------------'

Set intRow = Nothing
Set objContainer = Nothing
Set objExcel = Nothing
Set objRootLDAP = Nothing
Set objShell = Nothing
Set objSpread = Nothing
Set objUser = Nothing
Set strCN = Nothing
Set strCompany = Nothing
Set strDepart = Nothing
Set strDName = Nothing
Set strDSN = Nothing
Set strEmail = Nothing
Set strExpire = Nothing
Set strFirst = Nothing
Set strIDEPI = Nothing
Set strInital = Nothing
Set strLast = Nothing
Set strOU = Nothing
Set strSam = Nothing
Set strSheet = Nothing
Set strTitle = Nothing
Set strUser = Nothing


' ------------------------------------------------------'
' End.
' ------------------------------------------------------'

WScript.Echo "Complete!"
WScript.Quit

This conversation is currently closed to new comments.

2 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Answers

Back to Software Forum
2 total posts (Page 1 of 1)  

Software Forums