Temos um problema semelhante.
A única maneira que posso pensar é executar um script todas as noites que passará pelo diretório ativo e identificará qual conta expirará no dia seguinte. Em caso afirmativo, sinalize-o para alterar a senha. O código seria algo como o seguinte; Eu não tentei executar este script, então talvez seja necessário fazer alguns ajustes:
Const SEC_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const ADS_SCOPE_SUBTREE = 1000
dim strname
dim strdist
dim dtmvalue
on error resume next
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.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedName, profilepath, name from 'LDAP://dc=Example,dc=com' where objectCategory = 'User'"
Set objuserRecordSet = objCommand.Execute
objUSerRecordSet.MoveFirst
Do Until objuserRecordSet.EOF
strdist = objuserRecordSet.Fields("distinguishedName").Value
strname = objuserRecordSet.Fields("name").Value
Set objUserLDAP = GetObject _
("LDAP://" & strdist)
intCurrentValue = objUserLDAP.Get("userAccountControl")
dtmValue = objUserLDAP.PasswordLastChanged
If intCurrentValue and ADS_UF_DONT_EXPIRE_PASSWD Then
x = "The password does not expire."
Else
Set objDomainNT = GetObject("WinNT://escc.gov.uk")
intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
If intMaxPwdAge < 0 Then
x = "Password does not expire"
Else
intMaxPwdAge=intMaxPwdAge/86400
strold = ((dtmValue + intMaxPwdAge)-now)
if strold < 2 and strold > 0 then
objUserLDAP.pwdLastSet = 0
objUserLDAP.SetInfo
end if
end if
End If
dtmValue= ""
objuserrecordset.movenext
Loop