Hi Tom,
I have such a script. You will want to edit the SMTP server
information and from address to match your network. Put this script on
a DC and have it run as a scheduled task daily early in the morning.
It will query for passwords that need to be changed and send an email
to the user.
[code]
'=======================================================================
===
'
' NAME: NotifyPasswordExpireOWA.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' DATE : 04/15/2003
'
' COMMENT:
' Schedule to notify users that password will expire soon.
' This script should be run from the Exchange Server as a scheduled
task.
'
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
' ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
' THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
'
' IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE
SUPPLIERS
' BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
' DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
' WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
' ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
' OF THIS CODE OR INFORMATION.
'
'=======================================================================
===
'=============================
' First enumerate through users
' strComputer must be a Domain Controller, use "." for local
' or specify a remote server name within the quotes.
'=============================
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM
Win32_UserAccount",,48)
For Each objItem In colItems
strSAM = objItem.Name
strLDAP = SearchDistinguishedName(objItem.Name)
Set objUser = GetObject("LDAP://" & strLDAP)
strUserMail = objUser.mail
'Now check for the expiration
Check = CheckExpiration(strLDAP, strUserMail)
Set ObjUser = Nothing
Next
Function CheckExpiration(strUserDN, UserEmail)
'========================================
' This section of the script will check the users password for
expiration
' First, get the domain policy.
'========================================
Dim oDomain, oUser,maxPwdAge, numDays, daysToExpiration
Set sys = CreateObject("ADSystemInfo")
strDomainDN = sys.DomainShortName
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
'========================================
' Calculate the number of days that are
' held in this value.
'========================================
numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + _
maxPwdAge.LowPart) / CCur(-864000000000)
WScript.Echo "Maximum Password Age: " & numDays
'========================================
' Determine the last time that the user
' changed his or her password.
'========================================
Set oUser = GetObject("LDAP://" & strUserDN)
'========================================
' Add the number of days to the last time
' the password was set.
'========================================
whenPasswordExpires = DateAdd("d", numDays,
oUser.PasswordLastChanged)
'========================================
' Now get the number of days until expiration
'========================================
daysToExpiration = DateDiff("d", Now(),whenPasswordExpires)
'========================================
' Send the email if expiration is within parameters
'========================================
If daysToExpiration <= 10 Then
NotifyExpiration(UserEmail)
End If
'========================================
' Clean up.
'========================================
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
End Function
Function NotifyExpiration(oTo)
'=====================================
' You must customize the entry for oMyIP (your SMTP server address)
with the proper company information.
'=====================================
Dim oName, ODomain, oMyIP, sys
Set sys = CreateObject("ADSystemInfo")
'Below will use the AD DNS name for the email automatically or you can
'specifically set the value if the email domain is different.
ODomain = sys.DomainDNSName
' Company Internet Domain Name Uncomment next line and change value if
desired.
'ODomain = "YOURCOMPANY.com"
' Set the SMTP server IP
oMyIP = "192.168.1.2"
' Set the visual basic constants as they do not exist within VBScript.
' Do not set your smtp server information here.
Const cdoSendUsingMethod =
"http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer =
"http://schemas.microsoft.com/cdo/configuration/smtpserver"
'Create the CDO connections.
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
'SMTP server configuration.
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
'Set the SMTP server address here.
.Item(cdoSMTPServer) = oMyIP
.Update
End With
'Set the message properties.
With iMsg
Set .Configuration = iConf
.To = oTo
.From = oName & "@" & oDomain
.Subject = "Password About To Expire"
.TextBody = "This is a reminder that you must change your password.
To avoid being locked out, change your password now."
End With
'An attachment can be included.
'iMsg.AddAttachment Attachment
'Send the message.
iMsg.Send
End Function
Public Function SearchDistinguishedName(ByVal vSAN)
' Function: SearchDistinguishedName
' Description: Searches the DistinguishedName for a given
SamAccountName
' Parameters: ByVal vSAN - The SamAccountName to search
' Returns: The DistinguishedName Name
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" &
oRootDSE.get("defaultNamingContext") & _
">;(&(objectCategory=User)(samAccountName=" & vSAN &
"));distinguishedName;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function
[/code]
Hope that helps,
Mark D. MacLachlan
--