Login  | |
|
 |
Query AD by Date Created - 8/28/2008 1:34:49 AM
|
|
 |
|
| |
alayanna
Posts: 5
Score: 0
Joined: 8/28/2008
Status: offline
|
Hello! I was wondering if someone could help me with how to export users created within a date range to Excel. Here is what I have so far, but, it does not enumerate the users.
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
dtmCreationDate1 = "20080201000000.0Z"
dtmCreationDate2 = "20081231000000.0Z"
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" &_
"AND ObjMember.whenCreated>='" & dtmCreationDate1 & "' AND ObjMember.whenCreated<='" & dtmCreationDate2 & "'" 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
WhenCreated = ObjMember.WhenCreated
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
objwb.Cells(x,27).Value = WhenCreated
' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20
objwb.Cells(x,27+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 = "-"
WhenCreated = "-"
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"
objwb.Cells(1, 27).Value = "WhenCreated"
'formatting for header
Set objRange = objExcel.Range("A1","AA1")
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
|
|
| |
|
|
|
|
RE: Query AD by Date Created - 8/28/2008 1:49:07 AM
|
|
|
|
| |
dm_4ever
Posts: 2669
Score: 46
Joined: 6/29/2006
From: Orange County, California
Status: offline
|
It is not enumerating the users because you're only looking at object directly under the root....do a search and you will find a way to find all users.
_____________________________
dm_4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
|
|
| |
|
|
|
|
RE: Query AD by Date Created - 8/28/2008 2:15:07 AM
|
|
|
|
| |
dm_4ever
Posts: 2669
Score: 46
Joined: 6/29/2006
From: Orange County, California
Status: offline
|
Have you tried echoing out ObjMember.whenCreated to see what it shows as? When I tried it it was in standard date/time format. I think that if you were actually querying you would use the format you're currently trying to compare whenCreated to...but as it is you are enumerating all users and comparing...not initially querying.
_____________________________
dm_4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
|
|
| |
|
|
|
|
RE: Query AD by Date Created - 8/28/2008 3:12:06 AM
|
|
|
|
| |
dm_4ever
Posts: 2669
Score: 46
Joined: 6/29/2006
From: Orange County, California
Status: offline
|
First, I think your if statement is wrong...should be something like this
If ObjMember.Class = "user" & _
And ObjMember.whenCreated >= & dtmCreationDate1 And ObjMember.whenCreated <= dtmCreationDate2 Then ' if not User object, move on.
Secondly, what if you tried
dtmCreationDate1 = #02/01/2008#
dtmCreationDate2 = #12/31/2008#
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" & _
And CDate(ObjMember.whenCreated) >= & dtmCreationDate1 And CDate(ObjMember.whenCreated) <= dtmCreationDate2 Then ' if not User object, move on.
_____________________________
dm_4ever
My philosophy: K.I.S.S - Keep It Simple Stupid
Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
|
|
| |
|
|
|
|
RE: Query AD by Date Created - 8/28/2008 11:45:32 PM
|
|
|
|
| |
alayanna
Posts: 5
Score: 0
Joined: 8/28/2008
Status: offline
|
Thank you for your help...I ended up creating a different script that gave me the results I wanted
set objRootDSE = getobject("LDAP://RootDSE")
strExportFile = "C:\ADExport.xls"
strRoot = objRootDSE.Get("DefaultNamingContext")
strfilter = "(&(objectCategory=Person)(objectClass=User)(whenCreated>=20080201000000.0Z))"
strAttributes = "sAMAccountName,givenName,sn,description," & _
"initials,displayName,physicalDeliveryOfficeName," & _
"telephoneNumber,mail,profilePath," & _
"scriptPath,homeDirectory,title,department," & _
"company," & _
"info," & _
"streetAddress,postOfficeBox,l,st,postalCode,WhenCreated"
strScope = "subtree"
set cn = createobject("ADODB.Connection")
set cmd = createobject("ADODB.Command")
cn.open "Provider=ADsDSOObject;"
cmd.ActiveConnection = cn
cmd.commandtext = "<LDAP://" & strRoot & ">;" & strFilter & ";" & _
strAttributes & ";" & strScope
set rs = cmd.execute
set objExcel = CreateObject("Excel.Application")
set objWB = objExcel.Workbooks.Add
set objSheet = objWB.Worksheets(1)
For i = 0 To rs.Fields.Count - 1
objSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
objSheet.Cells(1, i + 1).Font.Bold = True
Next
objSheet.Range("A2").CopyFromRecordset(rs)
objWB.SaveAs(strExportFile)
rs.close
cn.close
set objSheet = Nothing
set objWB = Nothing
Set objRange = objExcel.Range("A1","Z1")
objRange.Interior.ColorIndex = 33
objRange.Font.Bold = True
objRange.Font.Underline = True
objExcel.Quit()
set objExcel = Nothing
|
|
| |
|
|
|
| |
|
|
 |
|
 |
|
|
Printable Version
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread