We help IT Professionals succeed at work.

VB Script to email users of pending password expiration

jmpatterson
jmpatterson asked
on
I would like to use a VB script to notify AD users via email when their passwords will expire in 10 dayss. Anyone have any ideas? Thanks!
Comment
Watch Question

Did you know that the Active Directory will alert them when they log in that their password is about to expire?

Author

Commented:
Yes I do.....so what do you do for your VPN users, non windows users, etc.......
I didn't think about those, however your question doesn't mention them either.
I found this script that looks like it will do the job.

http://www.myitforum.com/articles/6/view.asp?id=8546

Author

Commented:
I am looking for a tested solution....not someone elses "strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work"
Commented:
change line 37 to your smtp server name

for testing you can use this script part to see how long your password expire:

Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

Set objSysInfo = CreateObject("ADSystemInfo")
Set objNetwork = WScript.CreateObject("WScript.Network")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

intUserAccountControl = objUser.Get("userAccountControl")
dtmValue = objUser.PasswordLastChanged
Set objRootDSE = GetObject("LDAP://RootDSE")
Set objDomain = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
Set objMaxPwdAge = objDomain.Get("maxPwdAge")

dblMaxPwdNano = Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)

msgbox "The password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."




and then change the 10 in the script attached in this line:

If Int((dtmValue + dblMaxPwdDays) - Now) = 10 then

to numbers of days you left and see if you getting any message

just to know i tested the script on me and it's working, but there may be issue
if you mail server need authintication.
On Error Resume Next

On Error Resume Next

Const ONE_HUNDRED_NANOSECOND    = .000000100
Const SECONDS_IN_DAY            = 86400

Set objSysInfo = CreateObject("ADSystemInfo")
Set objNetwork = WScript.CreateObject("WScript.Network")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

intUserAccountControl = objUser.Get("userAccountControl")
dtmValue = objUser.PasswordLastChanged
Set objRootDSE = GetObject("LDAP://RootDSE")
Set objDomain = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
Set objMaxPwdAge = objDomain.Get("maxPwdAge")

dblMaxPwdNano = Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND  
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)     

If Int((dtmValue + dblMaxPwdDays) - Now) = 10 then
    strMsg = "The password will expire on " & _
    DateValue(dtmValue + dblMaxPwdDays) & " (" & _
    Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
    Email()
End if


 

Sub Email 
strEmailFrom = "do.not.reply@" & objNetwork.UserDomain
strEmailTo = objUser.mail
strEmailSubject = "Password Expire Notify"
strEmailBody = strMsg
strSMTP = "your_smtp_server_name"

Set objEmail = CreateObject("CDO.Message")
objEmail.From = strEmailFrom
objEmail.To = strEmailTo
objEmail.Subject = strEmailSubject
objEmail.Textbody = strEmailBody

objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
End Sub

 





 

Open in new window

Author

Commented:
Mail server does require authentication, I can not really tell 5000 users "you may get a test email". Perhaps I modifing the search to a single OU and adjusting the expiration time to pick up the accounts in that OU...simply as a test. I have been trying (with no luck) a similar script. My problem is objMessage seems to work partially but objEmail hangs.
Awarded 2009
Top Expert 2010

Commented:
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.