troubleshooting Question

Active directory password reminder email

Avatar of antonioking
antoniokingFlag for United Kingdom of Great Britain and Northern Ireland asked on
Active DirectoryVB Script
4 Comments1 Solution872 ViewsLast Modified:
I use the following vbs script to detect user accounts that passwords are due to expire within 10 days. It then sends them an email reminder to change their password...

'
' exch-pwd-expires.vbs
'
' Michael B. Smith
' March 21, 2005
'
' This program scans all users in the Users container and all organizational units
' beneath the HOSTING_OU organizational unit, for users whose passwords have either
' already expired or will expire within DAYS_FOR_EMAIL days.
'
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
' user to tell them to change their password. You should change strFrom to match
' the email address of the administrator responsible for password changes.
'
' You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the
' STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.
'
' If you don't have an OU containing sub-OU's to scan, then set HOSTING_OU to the
' empty string ("").
'

 Option Explicit

 ' Per environment constants - you should change these!
 Const HOSTING_OU  = ""
 Const SMTP_SERVER  = ""
 Const STRFROM   = ""
 Const DAYS_FOR_EMAIL  = 10

 ' System Constants - do not change
 Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7
 Const SECONDS_IN_DAY            = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

 ' Change to "True" for extensive debugging output
 Const bDebug   = true

 Dim objRoot
 Dim numDays, iResult
 Dim strDomainDN
 Dim objContainer, objSub

 Set objRoot = GetObject ("LDAP://RootDSE")
 strDomainDN = objRoot.Get ("defaultNamingContext")
 Set objRoot = Nothing

 numdays = GetMaximumPasswordAge (strDomainDN)
 dp "Maximum Password Age: " & numDays

 If numDays > 0 Then

  Set objContainer = GetObject ("LDAP://CN=Users," & strDomainDN)
  Call ProcessFolder (objContainer, numDays)
  Set objContainer = Nothing

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)

   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next

   Set objContainer = Nothing
  End If

  '========================================
  ' Add the number of days to the last time
  ' the password was set.
  '========================================
  whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)

  WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged
  WScript.Echo "Password Expires On: " & whenPasswordExpires
 End If

 WScript.Echo "Done"

Function GetMaximumPasswordAge (ByVal strDomainDN)
 Dim objDomain, objMaxPwdAge
 Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

 Set objDomain = GetObject("LDAP://" & strDomainDN)
 Set objMaxPWdAge = objDomain.maxPwdAge

 If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
  ' Maximum password age is set to 0 in the domain
  ' Therefore, passwords do not expire
  GetMaximumPasswordAge = 0
 Else
  dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
  dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
  dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
  GetMaximumPasswordAge = dblMaxPwdDays
 End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
 Dim intUserAccountControl, dtmValue, intTimeInterval
 Dim strName

 On Error Resume Next
 Err.Clear

 strName = Mid (objUser.Name, 4)
 intUserAccountControl = objUser.Get ("userAccountControl")

 If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
  dp "The password for " & strName & " does not expire."
  UserIsExpired = False
 Else
  iRes = 0
  dtmValue = objUser.PasswordLastChanged
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
   UserIsExpired = True
   dp "The password for " & strName & " has never been set."
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp "The password for " & strName & " was last set on " & _
    DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
    " (" & intTimeInterval & " days ago)"

   If intTimeInterval >= iMaxAge Then
    dp "The password for " & strName & " has expired."
    UserIsExpired = True
   Else
    iRes = Int ((dtmValue + iMaxAge) - Now)
    dp "The password for " & strName & " will expire on " & _
     DateValue(dtmValue + iMaxAge) & " (" & _
     iRes & " days from today)."

    If iRes <= iDaysForEmail Then
     dp strName & " needs an email for password change"
     UserIsExpired = True
    Else
     dp strName & " does not need an email for password change"
     UserIsExpired = False
    End If
   End If

  End If
 End If
End Function

Sub ProcessFolder (objContainer, iMaxPwdAge)
 Dim objUser, iResult

 objContainer.Filter = Array ("User")

 Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4)

 For each objUser in objContainer
  If Right (objUser.Name, 1) <> "$" Then
   If IsEmpty (objUser.Mail) or IsNull  (objUser.Mail) Then
    dp Mid (objUser.Name, 4) & " has no mailbox"
   Else
    If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
     wscript.Echo "...sending an email for " & objUser.Mail
     Call SendEmail (objUser, iResult)
    Else
     dp "...don't send an email"
    End If
   End If
  End If
 Next
End Sub

Sub SendEmail (objUser, iResult)
 Dim objMail

 Set objMail = CreateObject ("CDO.Message")

 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 objMail.Configuration.Fields.Update

 objMail.From     = STRFROM
 objMail.To       = objUser.Mail

 objMail.Subject  = "Your password is due to expire"
 objMail.Textbody = "Hi " & objUser.Name & vbCRLF & vbCRLF & _
	"The password for user account; " & objUser.sAMAccountName & ", is due to expire in " & iResult & " day(s)." & vbCRLF & _
	"To prevent potential authentication issues please change the password BEFORE it expires." & vbCRLF & vbCRLF & _
	"You can use CTRL+ALT+DEL and select ""Change password"" to change the password now." & vbCRLF & vbCRLF & _
	"Regards," & vbCRLF & _
	"Antonio King" & vbCRLF & vbCRLF & _
	"This is an automated message. You have received this message because your user account's password will expire in 10 or fewer days."

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
 If bDebug Then
  WScript.Echo str
 End If
End Sub


The line
 objMail.Textbody = "Hi " & objUser.Name & vbCRLF & vbCRLF & _

Outputs the text...
"Hi CN=<username>"

How do I remove the "CN=" part?
I'd also like to attach a pdf file to this email.
Can someone advise me on how to do this.

Regards,
Antonio King
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 4 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros