Over on Michael Smith’s blog, he has a script to notify users when their password is about to expire. This is handy for Exchange users who never log in to the network because they are offsite or on an extranet (i.e., POP3/IMAP4/RPC-HTTP users). It will crawl an OU and check the days until expiration and, if less than a variable you set, send an email via CDO.
However, at my office we don’t have these kinds of users in one OU. They are spread across multiple domains, but are all in a local group that has permission to a web page that allows them to change their password. So I updated the script to enumerate the members of this group. To accommodate different password aging settings in each domain I moved the domain query for this setting into the For loop. I also added logging so you will have a record of what was sent, not sent, and why. This way you can schedule it or run it interactively without having to adjust the code. Download it here, or copy below.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 |
Option Explicit ' Per environment constants - you should change these Const SMTP_SERVER = "ServerName" Const STRFROM = "From SMTP Address" Const DAYS_FOR_EMAIL = 14 'Send notification when pwd will expire in this number of days Const GROUPDN = "DN of group to enumerate" Const LOGFILE = "Patch and filename of log file" ' 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 = False Dim numDays, iResult Dim strDomain Dim objGroup, objMember, member Dim objFSO, objFile, strOutput Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(LOGFILE, 8, True) Set objGroup = GetObject("LDAP://" & GROUPDN) objFile.WriteLine "Executed at " & Now() & vbCRLF objFile.WriteLine "Enumerating members of " & objGroup.distinguishedName & ":" & vbCRLF For each member in objGroup.member Set objMember = GetObject("LDAP://" & member) objFile.WriteLine objMember.distinguishedname strDomain = Mid(objMember.distinguishedname, InStr(objMember.distinguishedname, "DC=")) numdays = GetMaximumPasswordAge (strDomain) Call ProcessUser (numDays) Next objFile.WriteLine "Done. Finished at " & Now() & "." objFile.Close 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 (objMember, iMaxAge, iDaysForEmail, iRes) Dim intUserAccountControl, dtmValue, intTimeInterval Dim strName On Error Resume Next Err.Clear strName = Mid (objMember.Name, 4) intUserAccountControl = objMember.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 = objMember.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" 'Swap commented variable below to force email to be sent (for testing). UserIsExpired = False 'UserIsExpired = True End If End If End If End If End Function Sub ProcessUser (iMaxPwdAge) Dim iResult, strExpire If Right (objMember.Name, 1) <> "$" Then If IsEmpty (objMember.Mail) or IsNull (objMember.Mail) Then dp Mid (objMember.Name, 4) & " has no mailbox" Else If UserIsExpired (objMember, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then objFile.WriteLine "Sending an email to " & objMember.givenName & " " & objMember.sn & _ " (" & objMember.Mail & "). Password expires in " & iResult & " days." & vbCRLF Call SendEmail (iResult) Else If iResult = "" Then strExpire = "." Else strExpire = " for " & iResult & " days." End If objFile.WriteLine "Skipping " & objMember.givenName & " " & objMember.sn & _ ". Password does not expire" & strExpire & vbCRLF End If End If End If End Sub Sub SendEmail (iResult) Dim objMail Set objMail = CreateObject ("CDO.Message") objMail.Configuration.Fields.Item ("<a href="http://schemas.microsoft.com/cdo/configuration/sendusing">http://schemas.microsoft.com/cdo/configuration/sendusing</a>") = 2 objMail.Configuration.Fields.Item ("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserver">http://schemas.microsoft.com/cdo/configuration/smtpserver</a>") = SMTP_SERVER objMail.Configuration.Fields.Item ("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserverport">http://schemas.microsoft.com/cdo/configuration/smtpserverport</a>") = 25 objMail.Configuration.Fields.Update objMail.From = STRFROM objMail.To = objMember.Mail objMail.Subject = "The Windows password is going to expire for " & Mid (objMember.Name, 4) objMail.Textbody = "The Windows Active Directory password for user " & objMember.givenName & " " & objMember.sn & _ " (" & objMember.sAMAccountName & ")" & " will expire in " & iResult & " days. " & vbCRLF & vbCRLF & _ "Please use Outlook Web Access (<a href="https://www.company.com">https://www.company.com</a>) to change it before it expires." & vbCRLF & vbCRLF & _ "Thank you," & vbCRLF & _ "Company Exchange Team" & vbCRLF & vbCRLF & _ "Note: You have received this email because you are a member of a group that is authorized to change your " & _ "password via Outlook Web Access since you do not log in to the corporate network. If this no longer applies to you, " & _ "please notify the Company Email Team (SMTPAddress) so you can be removed from the group." objMail.Send Set objMail = Nothing End Sub Sub dp (str) If bDebug Then objFile.WriteLine str End If End Sub |
Thank you for this script. How did you make the webpage that you use to have users change their own passwords? I am needing to do something similar. Thank you.
It is included in IIS6, but not in IIS7. Users can still change their password in IIS7 through OWA, but I believe it doesn’t use the iisadmpwd files that are in \windows\system32\inetsrv. Originally, I did customize the aexp2b.asp page to obfuscate it from hacker attempts and to allow only authorized users in a particular group to change their password. I have since opened it to everyone that has logged into OWA. There are articles about implementing iisadmpwd in IIS6 for OWA. If you can’t find them, or still need help, let me know.
Can you tell us how we can located the DN of the group we wish to enumerate?
There are multiple ways to get the dn, but a non-scripting method is to just use ADSI Edit, navigate to the object, open the properties, and scroll to the distinguishedName attribute. You can just copy and paste it from there.
Hi Scott,
I am trying to implement the above code but I am getting the following error at line 30 i.e. For each member in objGroup.member
ERROR: Object not a collection
Code: 800A01C3
Source: Microsoft VBScript runtime error
Neal, how many users do you have in the group? If there is only one member in a group, it won’t be returned as a collection. You can work around this by retrieving the attribute with the GetEx method, which always returns the value(s) as an array. If there is only one member in the group you can verify the existing code by simply adding someone else to it.
I have around 100 users in 1 OU. The code is working fine for 1 user if I eliminate the for loop as follows:
Set objGroup = GetObject(“LDAP://” & GROUPDN)
objFile.WriteLine “Executed at ” & Now() & vbCRLF
objFile.WriteLine “Enumerating members of ” & objGroup.distinguishedName & “:” & vbCRLF
‘For Each member in objGroup.member
Set objMember = GetObject(“LDAP://CN=Tom,OU=Dev,DC=BKEXCH,DC=COM” & member)
objFile.WriteLine objMember.distinguishedname
strDomain = Mid(objMember.distinguishedname,InStr(objMember.distinguishedname, “DC=”))
numdays = GetMaximumPasswordAge (strDomain)
Call ProcessUser (numDays)
‘Next
I’m trying to use your script on an SBS but I’m running into two errors — the first is the one Neal reports, saying “Object is not a collection”, and the second, when I comment out the FOR Loop like Neil suggests, is “PwdExpEmail.vbs(32,2) (null): 0x80005000.
Line 32 in my script is the following:
Set objMember = GetObject(“LDAP://” & member)
The above didn’t look right to me, so I changed it to be:
Set objMember = GetObject(“LDAP://” & member & GROUPDN) so it has a proper RDN reference, but it’s still not working, and I’m a little stumped as to why…
Jesse, the member variable that is used in Line 32 is already in the form of a distinguished name, so it is sufficient to use to bind to the user object. If a member of the group isn’t a user object, I can see that being a problem because the code is not checking the object type. To ensure you are working with a collection, like I mentioned in Neal’s reply, is to use the GetEx method, which returns the attribute as a collection even if it is a single-valued attributed. After you have retrieved the group, but before the For loop, get the members as a collection, then change the For loop to use that collection:
Dim colMembers
colMembers = objGroup.GetEx(“member”)
For each member in colMembers
This should at least resolved the error about it not being a collection.
the script is running, i am not receving the mails. Please help