VB Scripting - Sending emails and password expiry

[katana6434]

Hi All

I have this script, shown below, that I have got from various places on the internet.

This is to email users whos password is about to expire. A common problem.

As it stands, this script finds users in the OU's 1 level beneath the Hosting_OU. My question is how to enable this script to go more than one level deep. For example, at the moment it picks users in hosting_ou>ou1, but I need to find users in hosting_ou>ou1>users.

I am not an expert ny any means with VB scripting (quite a newbie really) so any help in this would be really great.

At the moment I have the send email function commented out for testing.

Thanks
Richard

Option Explicit

 ' Per environment constants - you should change these!
 Const HOSTING_OU  = "hosting_ou"
 Const SMTP_SERVER  = "x.x.x.x"
 Const STRFROM   = [email protected]
 Const DAYS_FOR_EMAIL  = 15

 ' 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

 ' Log file settings
 Dim strLogPath, strLogFile, fso, LogFile
 
 strLogPath = "C:\scripts\logs"
 strLogFile = "\Password_Expiry_Email.log"
 
 Set fso = CreateObject ("Scripting.FileSystemObject")
 If fso.FileExists(strLogPath & strLogFile) Then
    fso.DeleteFile(strLogPath & strLogFile)
 End If
 Set LogFile = fso.CreateTextFile(strLogPath & strLogFile)
 LogFile.Writeline(Now & " Password_Expiry_Email_Notification script started...")
  
 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 Now() & " Maximum Password Age: " & numDays & " days"

 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
 End If

 LogFile.Writeline(Now & " Password_Expiry_Email_Notification script ended...")
 Logfile.Close
 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 now() & " 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 Now() & " The password for " & strName & " has never been set."
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp Now () & " The password for " & strName & " was last set on " & _
    DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
    " (" & intTimeInterval & " days ago)"

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

    If iRes <= iDaysForEmail Then
     dp Now() & " " & strName & " needs an email for password change"
     UserIsExpired = True
    Else
     dp Now() & " " & 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")

 dp Now() & " 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 Now() & " " & Mid (objUser.Name, 4) & " has no email address in AD"
   Else
    If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
     dp Now() & " Sending an email for " & objUser.Mail
     'Call SendEmail (objUser, iResult)
    Else
     dp Now() & " Email not needed"
    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  = "Password is about to expire for " & Mid (objUser.Name, 4)
 objMail.Textbody = "The active directory password for user " & Mid (objUser.Name, 4) & _
    " (" & objUser.sAMAccountName & ")" & vbCRLF & _
    "will expire in " & iResult & " days. " & vbCRLF & _
    "Please change it as soon as possible." & vbCRLF & vbCRLF & _
    "Thank you," & vbCRLF & _
    "IT Helpdesk"

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
  LogFile.Writeline str
End Sub

 

[katana6434]

Thanks for that. i will have a look and see how I get on.

No, i didn't write all that out. I copied and pasted most of it from other sources.

Thanks