How can i list only accounts with account expiry and ignore the never expire ?

Hi,

Below script is used to query all user accounts in a specific OU and export their account information such as FirstName,Initial,LastName,Department and many other attributes plus account expiry information. Currently, the script is quering both the "never" and "End of".

Now i need someone to slightly modify the script to list only accounts with "End of" expiry information and ignore all accounts with "never" expire. The reason behind this because i am housekeeping the "People" OU where all user accounts are placed and i look only for accounts that expired and move them to another OU. Instead of generating a long list of user accounts and manually delete the never expire accounts which is time consuming, i need only to list accounts with "End of"

Appreciate your quick response.

Thanks
On Error Resume Next

SET objRootDSE = GETOBJECT("LDAP://RootDSE") 
strExportFile = "C:\test.xls"  

strRoot = "OU=people,DC=domain,DC=com" 
strfilter = "(&(objectCategory=Person)(objectClass=User))" 
strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _ 
                               "initials,displayName,physicalDeliveryOfficeName," & _  
                               "telephoneNumber,mail,wWWHomePage,profilePath," & _ 
                               "scriptPath,homeDirectory,homeDrive,title,department," & _ 
                               "company,manager,homePhone,pager,mobile," & _ 
                               "facsimileTelephoneNumber,ipphone,info," & _ 
                               "streetAddress,postOfficeBox,l,st,postalCode,distinguishedname," & _ 
                               "extensionAttribute1,extensionAttribute4,description" 
   
                               
                                    
strScope = "onelevel" 
 
SET cn = CREATEOBJECT("ADODB.Connection") 
SET cmd = CREATEOBJECT("ADODB.Command") 
cn.Provider = "ADsDSOObject" 
cn.Open "Active Directory Provider" 
cmd.ActiveConnection = cn 
  
cmd.Properties("Page Size") = 1000 
  
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) 
  
strCol = rs.Fields.Count + 1 
strRow = 2  
 
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.Cells(1, strCol).Value = "Account Expiration" 
objSheet.Cells(1, strCol).Font.Bold = TRUE 
 
 
 
objSheet.Range("A2").CopyFromRecordset(rs) 
 
rs.movefirst 
Do until rs.EOF 
strUser = rs.Fields("distinguishedname") 
 
Set objUser = GetObject ("LDAP://" & strUser) 
dtmAccountExpiration = objUser.AccountExpirationDate  
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then 
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire" 
Else 
        objSheet.Cells(strRow, strCol).Value = dtmAccountExpiration 
End If 
 
strRow = StrRow + 1 
 
rs.movenext 
loop 
 
 
objWB.SaveAs(strExportFile) 
  
  
rs.close 
cn.close 
SET objSheet = NOTHING 
SET objWB =  NOTHING 
objExcel.Quit() 
SET objExcel = NOTHING 
  
Wscript.echo "Script Finished..Please See " & strExportFile

Open in new window

LVL 1
amyasseinAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Psy053Commented:
You should be able to just remove these lines from the script:

If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire"
Else
        objSheet.Cells(strRow, strCol).Value = dtmAccountExpiration
End If
0
Psy053Commented:
Oops, wasn't paying attention,

You should be able to just remove this line:
  objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire"


0
Chris DentPowerShell DeveloperCommented:
Hey,

A quick modification to the filter will have it return only accounts with that value set.

This is everyone with an Account Expiration Date more recent than 01/01/1601 00:00:01.

Chris
On Error Resume Next

SET objRootDSE = GETOBJECT("LDAP://RootDSE") 
strExportFile = "C:\test.xls"  

strRoot = "OU=people,DC=domain,DC=com" 
strfilter = "(&(objectCategory=Person)(objectClass=User)(accountExpires<=10000000))" 
strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _ 
                               "initials,displayName,physicalDeliveryOfficeName," & _  
                               "telephoneNumber,mail,wWWHomePage,profilePath," & _ 
                               "scriptPath,homeDirectory,homeDrive,title,department," & _ 
                               "company,manager,homePhone,pager,mobile," & _ 
                               "facsimileTelephoneNumber,ipphone,info," & _ 
                               "streetAddress,postOfficeBox,l,st,postalCode,distinguishedname," & _ 
                               "extensionAttribute1,extensionAttribute4,description" 
   
                               
                                    
strScope = "onelevel" 
 
SET cn = CREATEOBJECT("ADODB.Connection") 
SET cmd = CREATEOBJECT("ADODB.Command") 
cn.Provider = "ADsDSOObject" 
cn.Open "Active Directory Provider" 
cmd.ActiveConnection = cn 
  
cmd.Properties("Page Size") = 1000 
  
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) 
  
strCol = rs.Fields.Count + 1 
strRow = 2  
 
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.Cells(1, strCol).Value = "Account Expiration" 
objSheet.Cells(1, strCol).Font.Bold = TRUE 
 
 
 
objSheet.Range("A2").CopyFromRecordset(rs) 
 
rs.movefirst 
Do until rs.EOF 
strUser = rs.Fields("distinguishedname") 
 
Set objUser = GetObject ("LDAP://" & strUser) 
dtmAccountExpiration = objUser.AccountExpirationDate  
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then 
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire" 
Else 
        objSheet.Cells(strRow, strCol).Value = dtmAccountExpiration 
End If 
 
strRow = StrRow + 1 
 
rs.movenext 
loop 
 
 
objWB.SaveAs(strExportFile) 
  
  
rs.close 
cn.close 
SET objSheet = NOTHING 
SET objWB =  NOTHING 
objExcel.Quit() 
SET objExcel = NOTHING 
  
Wscript.echo "Script Finished..Please See " & strExportFile

Open in new window

0
Acronis True Image 2019 just released!

Create a reliable backup. Make sure you always have dependable copies of your data so you can restore your entire system or individual files.

Psy053Commented:
Hey Chris, wont filtering on an expiration date later than 01/01/1601 still pickup accounts with an expiration date of 1/01/1970
0
Chris DentPowerShell DeveloperCommented:

Nope, because its ticks from 01/01/1601 not 01/01/1970 :)

See:

http://msdn.microsoft.com/en-us/library/ms675098%28VS.85%29.aspx

You have to love the lack of consistency with these epoch dates.

Chris
0
Chris DentPowerShell DeveloperCommented:

Or rather, yes it will pick up accounts with that date, but by design since never expires is a smaller value.

If you see what I mean...

Chris
0
Chris DentPowerShell DeveloperCommented:
I see where the confusion lies.

accountExpires, the attribute in AD, is the number of 100 nano-second intervals from 01/01/1601 00:00:00.

AccountExpirationDate, the property method on iADSUser, returns 01/01/1970 if the value is not set.

Because the filter is testing the value in the directory rather than invoking the method the filter should be just fine.

Like I said above, lack of consistency.

Chris
0
Psy053Commented:
Gotcha, thanks.
0
amyasseinAuthor Commented:
Thank you guys for the appreciated efforts.

Chris,

It's good to see you again bro. :) and thanks for paying attention.

Unfortunately, your modified script returned a blank Account Expiration column in the spreadsheet.

Thanks again.
0
amyasseinAuthor Commented:
Oh! i also forgot to say that i am sorry for the long delay as i was very busy at work. :)
0
Chris DentPowerShell DeveloperCommented:

Hmm I only changed the filter, I left the rest as it was.

You need to drop "On Error Resume Next", and when you do, can you verify that it throws this error on your version?

test.vbs(64, 9) Microsoft VBScript runtime error: Unknown runtime error

Chris
0
amyasseinAuthor Commented:
Chris,
Yes Exactly, it showed me this error when i removed the On Error Resume Next.

Sorry for the late reply :)

Cheers
0
Chris DentPowerShell DeveloperCommented:

No worries, thanks for checking :)

Can you try this version? I think it may be catching a little too much. It's a shame that adding accountExpires to the property set breaks it rather more terminally.

Anyway, this should work but it'll add the field as a string instead of a Date (cell formatting). It would be nice to see what it's adding into that column.

Chris
' On Error Resume Next

SET objRootDSE = GETOBJECT("LDAP://RootDSE") 
strExportFile = "C:\test.xls"  

strRoot = "OU=people,DC=domain,DC=com" 
strfilter = "(&(objectCategory=Person)(objectClass=User)(accountExpires<=10000000))" 
strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _ 
                               "initials,displayName,physicalDeliveryOfficeName," & _  
                               "telephoneNumber,mail,wWWHomePage,profilePath," & _ 
                               "scriptPath,homeDirectory,homeDrive,title,department," & _ 
                               "company,manager,homePhone,pager,mobile," & _ 
                               "facsimileTelephoneNumber,ipphone,info," & _ 
                               "streetAddress,postOfficeBox,l,st,postalCode,distinguishedname," & _ 
                               "extensionAttribute1,extensionAttribute4,description" 
   
                               
                                    
strScope = "onelevel" 
 
SET cn = CREATEOBJECT("ADODB.Connection") 
SET cmd = CREATEOBJECT("ADODB.Command") 
cn.Provider = "ADsDSOObject" 
cn.Open "Active Directory Provider" 
cmd.ActiveConnection = cn 
  
cmd.Properties("Page Size") = 1000 
  
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) 
  
strCol = rs.Fields.Count + 1 
strRow = 2  
 
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.Cells(1, strCol).Value = "Account Expiration" 
objSheet.Cells(1, strCol).Font.Bold = TRUE 
 
 
 
objSheet.Range("A2").CopyFromRecordset(rs) 
 
rs.movefirst 
Do until rs.EOF 
strUser = rs.Fields("distinguishedname") 
 
Set objUser = GetObject ("LDAP://" & strUser) 
dtmAccountExpiration = objUser.AccountExpirationDate  
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then 
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire" 
Else 
        objSheet.Cells(strRow, strCol).Value = CStr(dtmAccountExpiration)
End If 
 
strRow = StrRow + 1 
 
rs.movenext 
loop 
 
 
objWB.SaveAs(strExportFile) 
  
  
rs.close 
cn.close 
SET objSheet = NOTHING 
SET objWB =  NOTHING 
objExcel.Quit() 
SET objExcel = NOTHING 
  
Wscript.echo "Script Finished..Please See " & strExportFile

Open in new window

0
Psy053Commented:
Looking at that filter, shouldn't it be: (accountExpires>=10000000)
   i.e find accounts where the expiration date is greater than Jan 1, 1601?
0
Chris DentPowerShell DeveloperCommented:

Hmm yes, it should. Thank you :)

Chris
0
amyasseinAuthor Commented:
Hey Chris,

As always saying, sorry for the late reply :-)

I tried the latest script but it does the opposite, it lists only the accounts with never expired attribute. I need to list the accounts with the End of attribute. For example, the Account Expiration column only lists this date and time 1/1/1601 03:00 AM for all accounts.

Your response is highly appreciated.

Thanks
0
Chris DentPowerShell DeveloperCommented:

That'd be the error I managed to make with the filter, Psy03 has the right one and inserting that into the script gives the version below.

Chris
' On Error Resume Next

SET objRootDSE = GETOBJECT("LDAP://RootDSE") 
strExportFile = "C:\test.xls"  

strRoot = "OU=people,DC=domain,DC=com" 
strfilter = "(&(objectCategory=Person)(objectClass=User)(accountExpires>=10000000))" 
strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _ 
                               "initials,displayName,physicalDeliveryOfficeName," & _  
                               "telephoneNumber,mail,wWWHomePage,profilePath," & _ 
                               "scriptPath,homeDirectory,homeDrive,title,department," & _ 
                               "company,manager,homePhone,pager,mobile," & _ 
                               "facsimileTelephoneNumber,ipphone,info," & _ 
                               "streetAddress,postOfficeBox,l,st,postalCode,distinguishedname," & _ 
                               "extensionAttribute1,extensionAttribute4,description" 
   
                               
                                    
strScope = "onelevel" 
 
SET cn = CREATEOBJECT("ADODB.Connection") 
SET cmd = CREATEOBJECT("ADODB.Command") 
cn.Provider = "ADsDSOObject" 
cn.Open "Active Directory Provider" 
cmd.ActiveConnection = cn 
  
cmd.Properties("Page Size") = 1000 
  
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) 
  
strCol = rs.Fields.Count + 1 
strRow = 2  
 
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.Cells(1, strCol).Value = "Account Expiration" 
objSheet.Cells(1, strCol).Font.Bold = TRUE 
 
 
 
objSheet.Range("A2").CopyFromRecordset(rs) 
 
rs.movefirst 
Do until rs.EOF 
strUser = rs.Fields("distinguishedname") 
 
Set objUser = GetObject ("LDAP://" & strUser) 
dtmAccountExpiration = objUser.AccountExpirationDate  
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then 
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire" 
Else 
        objSheet.Cells(strRow, strCol).Value = CStr(dtmAccountExpiration)
End If 
 
strRow = StrRow + 1 
 
rs.movenext 
loop 
 
 
objWB.SaveAs(strExportFile) 
  
  
rs.close 
cn.close 
SET objSheet = NOTHING 
SET objWB =  NOTHING 
objExcel.Quit() 
SET objExcel = NOTHING 
  
Wscript.echo "Script Finished..Please See " & strExportFile

Open in new window

0
amyasseinAuthor Commented:
Chris,

The report still shows few accounts with never expired as they appear in the column as 1/1/1970.  If possible, i need that column to list only the accounts that are going to expire.

Thanks
0
Chris DentPowerShell DeveloperCommented:

One moment. Testing it again.

Chris
0
Chris DentPowerShell DeveloperCommented:

Okay, finally, I hope...

accountExpires is an odd attribute, it has a default (very large) value of 9223372032559810000 which is why it's been failing so badly. We also have to filter out those with 0 set because not all have the default value.

Could you give this one a blast?

Chris
' On Error Resume Next

SET objRootDSE = GETOBJECT("LDAP://RootDSE") 
strExportFile = "C:\test.xls"  

strRoot = "OU=people,DC=domain,DC=com"

' Filtering AccountExpires
strfilter = "(&(objectCategory=Person)(objectClass=User)(accountExpires<=9223372032559810000)(!accountExpires=0))"

strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _ 
                               "initials,displayName,physicalDeliveryOfficeName," & _  
                               "telephoneNumber,mail,wWWHomePage,profilePath," & _ 
                               "scriptPath,homeDirectory,homeDrive,title,department," & _ 
                               "company,manager,homePhone,pager,mobile," & _ 
                               "facsimileTelephoneNumber,ipphone,info," & _ 
                               "streetAddress,postOfficeBox,l,st,postalCode,distinguishedname," & _ 
                               "extensionAttribute1,extensionAttribute4,description" 
   
                               
                                    
strScope = "onelevel" 
 
SET cn = CREATEOBJECT("ADODB.Connection") 
SET cmd = CREATEOBJECT("ADODB.Command") 
cn.Provider = "ADsDSOObject" 
cn.Open "Active Directory Provider" 
cmd.ActiveConnection = cn 
  
cmd.Properties("Page Size") = 1000 
  
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) 
  
strCol = rs.Fields.Count + 1 
strRow = 2  
 
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.Cells(1, strCol).Value = "Account Expiration" 
objSheet.Cells(1, strCol).Font.Bold = TRUE 
 
 
 
objSheet.Range("A2").CopyFromRecordset(rs) 
 
rs.movefirst 
Do until rs.EOF 
strUser = rs.Fields("distinguishedname") 
 
Set objUser = GetObject ("LDAP://" & strUser) 
dtmAccountExpiration = objUser.AccountExpirationDate  
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/01/1970" Then 
        objSheet.Cells(strRow, strCol).Value = "Account Doesn't Expire" 
Else 
        objSheet.Cells(strRow, strCol).Value = CStr(dtmAccountExpiration)
End If 
 
strRow = StrRow + 1 
 
rs.movenext 
loop 
 
 
objWB.SaveAs(strExportFile) 
  
  
rs.close 
cn.close 
SET objSheet = NOTHING 
SET objWB =  NOTHING 
objExcel.Quit() 
SET objExcel = NOTHING 
  
Wscript.echo "Script Finished..Please See " & strExportFile

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
amyasseinAuthor Commented:
Chris,

BINGO! It's working like a beautifull princess. WOW

Now, i can list only all the contractors accounts with confidence.

I really appreciate your valuable effort Chris. Tell me how can i thank you ? :)

Keep up the excellent work man !

Thank you so much.
A.Y.
0
Chris DentPowerShell DeveloperCommented:

You're welcome :) Sorry it took so long to get to a proper solution :)

Chris
0
amyasseinAuthor Commented:
No man, it's okay with me...

And guess what! i also used your previous script for listing the never expired accounts as it will help me to find the direct hires easily.

In other words, all the scripts above added a benefit to me.

Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Active Directory

From novice to tech pro — start learning today.