Problem with AD / VBScript

[snakeeyes1978]

This script doesn't seem to work - can anyone see the problem?

On Error Resume Next

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strDNS = "LDAP://cn=Auto-IT," & strDNSDomain
'I have tested this connection and strDNS comes out as: LDAP://cn=Users,DC=mydomain,DC=com

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Set objContainer = GetObject(strDNS)
objContainer.Filter = Array("user")
For Each objUser In objContainer
lngFlag = objUser.Get("userAccountControl")
If (lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) = 0 Then
lngFlag = lngFlag Xor ADS_UF_DONT_EXPIRE_PASSWD
objUser.Put "userAccountControl", lngFlag XOR ADS_UF_DONT_EXPIRE_PASSWD
objUser.SetInfo
End If
Next
wscript.echo "Done"

 

[tsuji]

> lngFlag = lngFlag Xor ADS_UF_DONT_EXPIRE_PASSWD
> objUser.Put "userAccountControl", lngFlag XOR ADS_UF_DONT_EXPIRE_PASSWD
You've applied twice xor which is equivalent to keep the original flag unchanged.

 

[snakeeyes1978]

Spot on. Here's the corrected script which works in case anyone else comes across it

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strDNS = "LDAP://OU=Users," & strDNSDomain

Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Set objContainer = GetObject(strDNS)
objContainer.Filter = Array("user")
For Each objUser In objContainer
lngFlag = objUser.Get("userAccountControl")
If (lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) = 0 Then
lngFlag = lngFlag Xor ADS_UF_DONT_EXPIRE_PASSWD
objUser.Put "userAccountControl", lngFlag
objUser.SetInfo
End If
Next