Solved

VB Script to set password never expires attribute

Posted on 2009-05-19
8
2,983 Views
Last Modified: 2012-05-07
I need a VB Script to set password never expires attribute for all user accounts in active directory.
0
Comment
Question by:bbanis2k
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 12

Expert Comment

by:zoofan
ID: 24422776
Hello,

edit line 10 to reflect the correct domain.

strBase = "<LDAP://DC=domain,DC=local>"

zf
Dim objConnection, objCommand, objRootDSE, strDNSDomain

Dim strFilter, strQuery, objRecordSet

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

cn = "*"

Set objConnection = CreateObject("ADODB.Connection")

Set objCommand = CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOOBject"

objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection

strBase = "<LDAP://DC=domain,DC=local>"

strFilter = "(&(objectCategory=person)(objectClass=user)(cn=" & cn & "))"

strAttributes = "distinguishedName"

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

objCommand.CommandText = strQuery

objCommand.Properties("Page Size") = 99999

objCommand.Properties("Timeout") = 300

objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

    strDN = objRecordSet.Fields("distinguishedName")		

		Set objUser = GetObject("LDAP://" & strDN)

		intUAC = objUser.Get("userAccountControl")	 

		If ADS_UF_DONT_EXPIRE_PASSWD AND intUAC Then

		    'Do Nothing

		Else

		    objUser.Put "userAccountControl", intUAC XOR _

		        ADS_UF_DONT_EXPIRE_PASSWD

		    objUser.SetInfo

		End If

    objRecordSet.MoveNext

Loop

objConnection.Close

Set objConnection = Nothing

Set objCommand = Nothing

Set objRootDSE = Nothing

Set objRecordSet = Nothing

Open in new window

0
 
LVL 38

Accepted Solution

by:
Shift-3 earned 500 total points
ID: 24422783
It would be easier to do it with this command:
dsquery user -limit 0|dsmod user -pwdneverexpires yes

Run it on a 2003 server or an XP workstation with the adminpak installed.
0
 
LVL 3

Expert Comment

by:Cameron_S
ID: 24422799
This is what I found from Microsoft, albeit with a little modifying on my end:


Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 

Set objUser = GetObject ("LDAP://cn=JohnDoe,ou=YourOU,dc=Your,dc=Domain,dc=com")

intUAC = objUser.Get("userAccountControl")
 

If intUAC AND ADS_UF_DONT_EXPIRE_PASSWD Then

objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD

objUser.SetInfo

End If

Open in new window

0
 

Author Comment

by:bbanis2k
ID: 24422886
Zoofan: Error on line 22. Null

Shift-3: This is a 2008 EBS environment

Cameron: That is per user account.
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 12

Expert Comment

by:zoofan
ID: 24423068
Hello, be sure your domain name is ocrrect in line 10.  Sorry as I do not have a 08 server to test with but set correctly works good in 03.

zf
0
 
LVL 3

Expert Comment

by:Cameron_S
ID: 24423373
Are all user accounts within a single OU? Are they within the Users OU (which is technically a CN, so that may be where errors a popping up)?
0
 

Author Closing Comment

by:bbanis2k
ID: 31583007
Downloaded to my XP laptop...and it worked!  Yeah!
0
 
LVL 3

Expert Comment

by:Cameron_S
ID: 24423610
Alright, here you go, I managed to merge the two together. Make sure you change the objCommand = CommandText = to match your schema!

Basically, it searches your Domain (Replace DOMAIN and COM with your Domain information respectively - make sure you follow the FQDN format that the script uses) and finds all users who do not have the Password Does Not Expire flag set. It then sets that user so that the password does not expire and moves on to the next record.

Hope this helps!

Cheers,
Cameron

Original Source From: http://www.microsoft.com/technet/scriptcenter/resources/qanda/aug05/hey0829.mspx
On Error Resume Next

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 

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.CommandText = "<LDAP://dc=DOMAIN,dc=COM>;" & "(&(objectCategory=User)(!(userAccountControl:1.2.840.113556.1.4.803:=65536)));" & "Name,cn,AdsPath;Subtree"

Set objRecordSet = objCommand.Execute
 

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

	Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)

	intUAC = objUser.Get("userAccountControl")

	objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD

	objUser.SetInfo

	objRecordSet.MoveNext

Loop

Open in new window

0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

747 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now