VB Scripting - Sending emails and password expiry

katana6434 · 12 Jul 2011 at 12:36

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

HungryHippos · 12 Jul 2011 at 21:14

Observe this script I wrote to change UPN's for users in VBS, this uses ADSI to search a subtree of an OU for users and then binds to each user via Recordset, and then gets/sets attributes on a per user basis, maybe this will help you?

Code:

'==================================================================================================
' COMMENT: 
'
'   Change UPN - this is typically done after a default domain change.
'   
'==================================================================================================

On Error Resume Next

Set objFSO = CreateObject("Scripting.FileSystemObject")

CurrentDir = objFSO.GetAbsolutePathName("")
CurrentDir = CurrentDir & "\"

'//////////////////////////////////////////////////////////////////////
'
' Fill in the DN of the OU you want to search within
' Enter the filename you want to store the results in
' <!-- Start of Customisation -->

OU = "OU=Hosting_OU,DC=Domain,DC=com"
LogFileName = CurrentDir & "Log.csv"

' <!-- End of Customisation --> 
'
'//////////////////////////////////////////////////////////////////////

Set LogFile = objfso.CreateTextFile(LogFileName, true)

'constansts for AD searching. base searches the OU above the one you specify, Onelevel searches the ou you specify only, subtree searches the ou you specify and all sub ou's
Const ADS_SCOPE_BASE = 0
Const ADS_SCOPE_ONELEVEL = 1
Const ADS_SCOPE_SUBTREE = 2

'Clears the value (or values) from the specified attribute.
Const ADS_PROPERTY_CLEAR = 1
'Replaces the value in the specified attribute with new values.
Const ADS_PROPERTY_UPDATE = 2
'Appends a new value (or values) to the specified attribute.	
Const ADS_PROPERTY_APPEND = 3
'Deletes the value (or values) from the specified attribute.
Const ADS_PROPERTY_DELETE = 4

'Standard code to create an ADODB connection and the command properties
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

'Set the connection properties.
'Encrypts user information when logging into AD. Optionally you can enter a username and password to login, default behaviour is to use your logged in credentials. Uncomment these if you want to use them.
objConnection.Properties("Encrypt Password") = TRUE
objConnection.Properties("ADSI Flag") = 1
'objConnection.Properties("User ID") = "Username"
'objConnection.Properties("Password") = "Password"
'Page size means the number of items per page, without setting this it will go through only 1000 items
objCommand.Properties("Page Size") = 1000
'Sets the scope of the search. BASE searches the OU above the one specified only. ONELEVEL searches the OU specified only. SUBTREE searches the OU specified along with all sub ou's.
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
'How you want the data sorted.
objCommandProperties("Sort On") = "Name"

'use a SQL based query to return specific values from the LDAP path of the OU where the object class is the one specified.
objCommand.CommandText = _
    "SELECT SAMAccountName, ADsPath FROM 'LDAP://" & OU & "' WHERE objectClass='user'"
'Execute the query above to return records. 
Set objRecordSet = objCommand.Execute

'Go to first record returned
objRecordSet.MoveFirst

'Loop through until there are no records left.
Do Until objRecordSet.EOF

	strObjectPath = objRecordSet.Fields("ADsPath").Value
	strCurrentObject = objRecordSet.Fields("SAMAccountName").Value
        
	Set objCurrentObject = GetObject(strObjectPath)
            
		strName = objCurrentObject.Get("name")

		objCurrentObject.put "userPrincipalName", strName
		objCurrentObject.SetInfo	

		LogFile.writeline strCurrentObject & "," & strName


'Clear Entries
strObjectPath = ""
strCurrentObject = ""
objCurrentObject = ""
strName = ""

'Move to next record.    
objRecordSet.MoveNext

'Loop if there are more records.
Loop

LogFile.close

Scythian · 13 Jul 2011 at 02:25

Quick Q (Never wrote a program before) - Do you write all that out 'manually'? or are there tools to help?

katana6434 · 13 Jul 2011 at 17:39

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