Password Age Script

suriyaehnop
suriyaehnop used Ask the Experts™
on
I been using this script in enviroment for so long. It work quite well in WindowsServer 2003. While after migrate to Windows Server 2008, I felt that the script not work as before. The script will stop to work and when i try to delete the output file,it will appear as screenshot. What I have to do is to restart the server so that I can delete the output files (txt file)and create a new one then start the tun the script again (schedule using task schedule). One more thing thatI found when the script run the query of password age, and when time to send an email notification, it will failed for those who don't email address at AD User account properties. if this problem occur, the script will stop to check others AD Users.

It is possible to let scripts to query AD USER with mailbox enabled only? or if there is another script (powershell) which able to send notification to user, able to produce output file then send the file to administrator, kindly share.

' John Savill 8th June 2005
' Runs check on last password change date
'
Option Explicit
 
Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, objRootDSEstrPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
Dim strQuery, objRecordset, strName, strCN, objLogfile, objFSO 
Dim oWshShell : Set oWshShell = CreateObject("WScript.Shell")
Dim strNoOfDays
Dim objRootDSE, strPasswordChangeDate
 
' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************
 
PasswordExpiry=90
'strRootDomain="dc=sapura,dc=com"
Set objRootDSE = GetObject("LDAP://RootDSE")
strRootDomain = objRootDSE.get("defaultNamingContext")
 
' *****************************************************************************************************************************************
'create logfile
Const ForWriting = 2
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.CreateTextFile("PasswordExpirelog.txt", _ 
    ForWriting, True)
'objLogFile.Writeline "List of users With Password That Nearly Expire" 
objLogFile.Writeline "*********************************************" 
objLogFile.Writeline
 
 
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
  lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
  lngTZBias = 0
  For k = 0 To UBound(lngBiasKey)
    lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
  Next
End If
 
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strRootDomain & ">"
 
strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectCategory=person)(objectClass=user)(!userAccountControl:1.2.840.113556.1.4.803:=65536)(!mail=SystemMailbox{1774B3FC-F88F-4B94-BE49-E23BF6796401}@sapura.com.my))"
strAttributes = "displayName,cn,mail,pwdLastSet,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
oWshShell.Popup "Running at " & Date(), 1
 
 
Do While Not objRecordSet.EOF
  strName = objRecordSet.Fields("displayName").Value
  strCN = objRecordSet.Fields("cn").value
  strEmailAddress = objRecordSet.Fields("mail").value
  oWshShell.Popup "NT Name: " & strName & ", Common Name: " & strCN, 1
  
' write user info to logfile
 
 'oWshShell.Popup vbtab & "DistinguishedName: " & objRecordSet.Fields("distinguishedName").Value, 1
  On Error Resume Next
  Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
  If Err.Number = 0 Then
	  On Error GoTo 0
	  Set objPwdLastSet = objUserConnection.pwdLastSet
	  strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
	 
	  'oWshShell.Popup vbTab & "Password last changed at " & strPasswordChangeDate, 1
	  intPassAge = DateDiff("d", strPasswordChangeDate, Now)
	  oWshShell.Popup vbTab & "Password changed " & intPassAge & " days ago", 1
	 
	  If intPassAge = (PasswordExpiry-1) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 1 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 1 " & " days"  
	  objLogFile.Writeline 
	  Call SendEmailMessage(strEmailAddress, 1) 
	 
	  ElseIf intPassAge = (PasswordExpiry-2) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 2 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 2 " & " days" 
	  objLogFile.Writeline  
	  Call SendEmailMessage(strEmailAddress, 2) 
	  
	  ElseIf intPassAge = (PasswordExpiry-3) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 3 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 3) 
	 
	  ElseIf intPassAge = (PasswordExpiry-4) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 4 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 4 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 4) 
	 
	 
	  ElseIf intPassAge = (PasswordExpiry-5) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 5 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 5 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 5)
	 
	  ElseIf intPassAge = (PasswordExpiry-6) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 6 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 6)
	 
	  ElseIf intPassAge = (PasswordExpiry-7) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 7 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 7 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 7)

          ElseIf intPassAge = (PasswordExpiry-12) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 12 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 12 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 12)

          ElseIf intPassAge = (PasswordExpiry-13) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 13 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 13 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 13)
	 
	  ElseIf intPassAge = (PasswordExpiry-14) Then
	  oWshShell.Popup vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 14 days", 1
	  objLogFile.Writeline " Display Name :" & strName 
	  objLogFile.Writeline " Email        :" & strEmailAddress
	  objLogFile.Writeline " Password Expires in 14 " & " days"
	  objLogFile.Writeline
	  Call SendEmailMessage(strEmailAddress, 14)
	 
	 
	  
	  End If
	Else
	   Err.Clear
	   On Error GoTo 0
	   oWshShell.Popup vbtab & "Error binding to " & objRecordSet.Fields("distinguishedName").Value, 1
	End If
 
  objRecordSet.MoveNext
Loop
 
objConnection.Close
 
Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
  Dim lngAdjust, lngDate, lngHigh, lngLow
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
  ' Account for error in IADslargeInteger property methods.
  If lngLow < 0 Then
    lngHigh = lngHigh + 1
  End If
  If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
  End If
  lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
  + lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is overly large
  On Error Resume Next
  Integer8Date = CDate(lngDate)
  If Err.Number <> 0 Then
    On Error GoTo 0
    Integer8Date = #1/1/1601#
  End If
  On Error GoTo 0
End Function
 
Sub SendEmailMessage(strDestEmail, strNoOfDays)
  Set objMessage = CreateObject("CDO.Message") 
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "send.sapura.com.my"
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objMessage.Configuration.Fields.Update
  objMessage.Subject = "Password Expires in " & strNoOfDays & " days" 
  objMessage.From = "Password-Notifier@sapura.com.my" 
  objMessage.To = strEmailAddress 
  objMessage.TextBody = "Your password expires in " & strNoOfDays & " day/s. Please change your password at http://webmail.sapura.com.my to prevent further logon problems." & vbCRLF & vbCRLF & vbCRLF & vbCRLF  & "Regards," & vbCRLF & vbCRLF & "Sapura Postmaster"
  'objLogFile.Writeline
  'objLogFile.Writeline
  'objMessage.TextBody = "Regards,"
  'objLogFile.Writeline
  'objMessage.TextBody = "Sapura Postmaster"
   objMessage.Send
End Sub

Open in new window

Test.png
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
ThinkPaperIT Consultant

Commented:
Not sure if it will resolve it, but make sure you are "closing" are you loose ends at the end of the script

objLogFile.close
Set objLogFile = NOTHING
Set oWshShell = NOTHING
Craig PedigoSystems Programmer

Commented:
As part of a script I use I run an LDAP query where I am checking for the name & email.  If the AD account has an email address then I send an email  to the user and add their info to a table, if there is no email I only add it to a table.  (strUserName is a varialbe used to  house the AD user name passed to it from a function call)

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection

objCommand.CommandText = "Select DistinguishedName, mail, cn from 'LDAP://DC=yourdomain,DC=com' Where objectCategory='user' AND SAMAccountName  = '" & strUserName & "'"

Author

Commented:
Hi Cpedigo,

Interested with your scripts. It is able to combine with my scripts? and what is the final script look like?
Systems Programmer
Commented:
Here is my script (you would have to replace tings like "yourdomain" with the name of your domain and your email server.  This script cretes a hidden excel object then scands AD and adds those with passwords that expire qwithin two days or that have already expired to the  exce lobject and emails them via a CDO object.  It may not be very neat but once I got it working I moved on to other things and did not go back to clean it up.  Hope that helps!

 8-{)}
'**************************************************************************************************
'Check to see if launched by double-click or in WScript and then launch in CScript
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /k cscript //nologo " & Chr(34) & strPath & chr(34)
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand)
    Wscript.Quit
End If
'**************************************************************************************************
'Main
'Create variables, objects, misc. setup

' set strDebug to TRUE to log only, no emails
strDebug = False

strDC="server.domain.com"    'FQDN of domain controller  XXXX.domain.com
strDomain = "domain"         '  Name of domain (without the .com)

Set StdOut = WScript.StdOut
dim strMail, strEmail_array(), str_split_array(), x, y, send_email_to_users
dim already_expired, strHTML

clear=chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8) & chr(8)
spaces=string(30," ")
set fso = CreateObject("Scripting.FileSystemObject")
'---------------------------------------------------------------------------------------------------

' Create/overwrite log file
set oFile=fso.CreateTextFile("C:\Expired_passwords.html")

'---------------------------------------------------------------------------------------------------

' Get collection of user names from ADS domain object

Set objComputer = GetObject("WinNT://" & strDC)

objComputer.Filter = Array("User")
'ofile.writeline("<font face = 'Times New Roman' size = '3'>")
strHTML = "<html>" & VBCrLF & "<body>" & VBCrLF &  "<font face = 'Times New Roman' size = '3'>"

'oFile.writeline("<table border='1'><tr><td width='100'>Account</td><td width='250'>OU</td><td width = '100'>Password Expires</td><td width = '100'>Email</td></tr>")
strHTML = strHTML & vbCrLF & "<table border = '1' width='100%'>"
strHTML = strHTML & vbCrLF & "     <tr><td width='100'>Account</td>"
strHTML = strHTML & vbCrLF & "         <td>OU</td>"
strHTML = strHTML & vbCrLF & "         <td>Password Expires</td>"
strHTML = strHTML & vbCrLF & "         <td>Email</td>"
strHTML = strHTML & vbCrLF & "      </tr>"

'ofile.writeline("Account" & chr(9) & "OU" & chr(9) & "Password expires" & chr(9) & "Email")
line_count=0   ' For the email array

    ' Cycle through the collection and show name on screen for progress
    For Each objUser In objComputer
	the_ou=""
	intPasswordAge = objUser.PasswordAge
	intPasswordAge = intPasswordAge * -1 
	dtmChangeDate = DateAdd("s", intPasswordAge, Now)
	strPassword_expires = dtmChangeDate + 30
	stdout.write(clear)
	stdout.write(spaces)
	stdout.write(clear)
	stdOut.write("Checking " & objUser.Name)
	the_ou=get_dn(objUser.Name)

	' Check to see if password expriation date is within 1 day in the future and not more than 1 day in the past, and not flag disabled accounts

  if password_never_expires = False then
	
 	if strPassword_expires >= (NOW-2) and strPassword_expires <= (NOW + 2) and objUser.AccountDisabled=FALSE  then
	
		'Resize the variable array storing the user information to account for new user found meeting the expired password criteria
		redim Preserve strEmail_array(line_count)
		strEmail_array(line_count) = strMail & "~" & strPassword_expires & "~" & objUser.Name & "~" & the_ou
		line_count = Line_count + 1
		'ofile.writeline("<tr><td>" & objUser.Name & "</td><td>" & the_ou & "</td><td>" & strPassword_expires & "</td><td>" & strMail& "</td></tr>")
		strHTML = strHTML & vbCrLF & "<tr>"
		strHTML = strHTML & vbCrLF & "   <td>" & objUser.Name & "</td>"
		strHTML = strHTML & vbCrLF & "   <td>" & the_ou & "</td>"
		strHTML = strHTML & vbCrLF & "   <td>" & strPassword_expires & "</td>"
		strHTML = strHTML & vbCrLF & "   <td>" & strMail& "</td>"
		strHTML = strHTML & vbCrLF & "</tr>"
		'ofile.writeline(objUser.Name & chr(9) & the_ou & chr(9) & strPassword_expires  & chr(9) & strMail)
	end if


  Else
  end if
   Next
'ofile.writeline("</table>")
strHTML = strHTML & vbCrLF & "</table>" & vbCrLF & "</body>" & VBCrLF & "</html>"

ofile.writeline(strHTML)
' resize 2cnd array to parse out fields from first array since they had to be stored in a single string
redim str_split_array(line_count,4)


'---------------------------------------------------------------------------------------------------

'Split array to second array

'     Split_Array items: 1: Email, 2: Password_Expires, 3: user name  and 4: The OU

' set counter L to 2 so it will start adding data to cells in spreadsheet AFTER header row
L=2

for y = 0 to line_count - 1
	the_split = split(strEmail_Array(y),"~",4)
	str_split_array(y,1) = the_split(0)
	str_split_array(y,2) = the_split(1)
	str_split_array(y,3) = the_split(2)
	str_split_array(y,4) = the_split(3)
L = L + 1
NEXT

set oFile = Nothing
set objCOmputer = Nothing

'---------------------------------------------------------------------------------------------------
' Send the emails

' Set flag that checks for ads accounts with no email address entered
accounts_with_no_mail = False

' syntax:   r= MsgBox(prompt[,buttons][,title][,helpfile,context])
' MSGBox options
' 1 = vbOK - OK was clicked 
' 2 = vbCancel - Cancel was clicked 
' 3 = vbAbort - Abort was clicked 
' 4 = vbRetry - Retry was clicked 
' 5 = vbIgnore - Ignore was clicked 
' 6 = vbYes - Yes was clicked 
' 7 = vbNo - No was clicked 




send_email_to_users = True


' Create html body of email for those accounts with no email address configured


strNoMail="<font face = 'Times New Roman' size = '3'><table border = '1' width= '500'><tr><td width='100'>Account</td><td width='400'>OU</td></tr>"


' Cycle through the 2cnd array (housing the split data) and check for those without an email address.  If no address set flag "accounts_with_no_mail" to
' "True" so it will create an email summarizing those accounts whose passwords expire but have no email address.

for x = 0 to line_count - 1
	if str_Split_array(x,1) = "none" then

		' add entires with no email to single variable housing body of email message
		strNoMail = strNoMail & "<tr><td>" & str_split_array(x,3) & "</td><td>" & str_split_array(x,4) & "</td></tr>"
		accounts_with_no_mail=True
	else
		if send_email_to_users=True then 
			mail_it str_split_array(x,1), str_split_Array(x,2), str_split_Array(x,3)
			stdout.write(clear)
			stdout.write(clear)
			stdout.write(spaces)
			stdout.write(spaces)
			stdout.write(clear)
			stdout.write(clear)
		end if
	end if
next

'complete html coding of table for email message body
strNoMail = strNoMail & "</table>"

' If there were any accounts found with no email address pass them to the mail_it function to email summary
if accounts_with_no_mail = True then mail_it "none", "none", strNoMail


' Finish
rem if send_email_to_users = False then r = msgbox("See " & strOutput_File & ".xls for summary of accounts with expiring passwords." & vbCrLF & "Thils file was also written as " & strOutput_file & ".log, which is tab-delimited for pasting into Excel, in case the Excel save fails.")

rem if send_email_to_users = True then r=msgbox("Emails sent!  See " & strOutput_File & ".xls for summary of accounts with expiring passwords." & vbCrLF & "Thils file was also written as " & strOutput_file & ".log, which is tab-delimited for pasting into Excel, in case the Excel save fails.")

set fso = Nothing

send_summary

wscript.quit


'******************************************************************************************************************

function get_dn(strUserName)
if instr(strUserName,"'") then strUsername = replace(strUsername,"'","''")

strOUOut=""
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 =   CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCOmmand2.ActiveConnection = objConnection2
objCommand2.CommandText = "Select DistinguishedName, mail, cn from 'LDAP://DC=" & strDC & ",DC=com' Where objectCategory='user' AND SAMAccountName  = '" & strUserName & "'"
objCommand2.Properties("Page Size") = 1000

err.clear
on error resume next
Set objRecordSet2 = objCommand2.Execute
if err.number <> 0 then
	 wscript.echo("ObjRecordset2 command execute err.number: " & err.number)
else

	err.clear
	on error resume next
	objRecordSet2.MoveFirst
	if err.number <>0 then wscript.echo("objRecordSet2.MoveFirst err.number: " & err.number)

	Do Until objRecordSet2.EOF

		strOuOut=""
		strMail=""
		strUser=objRecordSet2.Fields("distinguishedName").Value
		strMail=objRecordSet2.Fields("mail").Value
		if isNull(objRecordSet2.Fields("mail").Value) then strMail = "none"



		password_expires = get_pwexp(strUser)

		on error resume next
		dim strDC, strOU
		strDC=split(ucase(objRecordSet2.Fields("distinguishedName").Value),ucase(",dc=" & strDC & ",dc=com"))
		strOU=split(strDC(0),",")
			x=ubound(strOU)
			do until x = 0
			  if instr(ucase(strOU(x)),"OU=") then strOUOut = strOUOut & "/" & Mid(strOU(x),4,len(strOU(x))-3)
			  if instr(ucase(strOU(x)),ucase("CN=Users")) then strOUOut = "/Users"
			x=x-1
			loop
	    objRecordSet2.MoveNext
	Loop	
end if

set objConnection2 = Nothing
set objCommand2 = Nothing
set objRecordSet2 = Nothing

get_dn = strOUOut
end function

'*********************************************************************************************************************


function get_pwexp(the_DN)
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000


set objUser2 = GetObject("LDAP://" & the_DN)
	intUserAccountControl = objUser2.Get("userAccountControl")
	r=intUserAccountControl
	If objUser2.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then 
		strPWExp="N"
		password_never_expires = True
	else
		strPWExp="Y"
		password_never_expires = False
	end if
	

get_pwexp=strPWExp

set intUserAccountControl = Nothing
set objUser2 = Nothing

end function

'******************************************************************************************************************

Function mail_it(tmp1, tmp2, tmp3)
if strDebug = True then exit function
' tmp1 is the email address
' tmp2 is the expiration date
' tmp3 is the user ads name
tmpDay = Weekdayname(weekday(tmp2))
tmpNow=NOW
tmpdate=datevalue(tmp2)
		if tmpdate <= tmpNOW then
			already_expired=True
		else
			already_expired = False
		end if

' If ads account has no email address then send summary to Craig

If tmp1 = "none" and tmp2 = "none" then 
the_bod=the_bod & "<html><p><font size = '4'>Windows passwords expire for the accounts listed below but " & vbCRLF
the_bod=the_bod & "they do not have an email address configured in ADS.  Please have server admins correct a.s.a.p.</p>" & vbCRLF
the_bod=the_bod & tmp3 & vbCRLF
the_bod=the_bod & "</p>" & vbCRLF
the_bod=the_bod & "<p>(This is a system-generated email)</p></font></html>" & vbCRLF

Set objEmail = CreateObject("CDO.Message")
objEmail.From = "sender@yourdomain.com"
objEmail.Subject = "Windows accounts with passwords expiring but no email address in ADS"
objEmail.To = "receiver@yourdomain.com"
objEmail.HTMLBody=the_bod
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "emailserver.yourdomain.com" 
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

set objEmail = Nothing

else

the_bod="<font size = '4' face = 'Times New Roman'>" & vbCRLF
the_bod=the_bod &  "<strong>Account: " & tmp3 & " </strong>with email address <strong>" & tmp1 & "</strong></p>"
if already_expired = True then
	the_bod=the_bod &  "<p>Your windows password has already expired: <strong><font color='red'>" & tmpDay & ", " & tmp2 & "</strong></font></p>" & vbCRLF
else
	the_bod=the_bod &  "<p>Your windows password is about to expire: <strong><font color='red'>" & tmpDay & ", " & tmp2 & "</strong></font></p>" & vbCRLF
end if
the_bod=the_bod & "<p><font size = '4' face = 'Times New Roman'>Please note the <i>time</i> your password expires.  You MUST change your password before that time, even though" & vbCRLF
the_bod=the_bod & "the message you got at logon may have said you have one more day, it only checks the day, not the time.<br>" & vbCRLF
the_bod=the_bod & "If you have already changed your password before you received this email you may ignore it.  However, if you logged on this morning" & vbCRLF
the_bod=the_bod & " without changing your password and it said you have one day AND you received this email then your password <i>has</i> expired and you need to close all" & vbCRLF
the_bod=the_bod & " your programs, press CNTL-ALT-DEL, change your password and then shutdown/restart.</p>" & vbCRLF
the_bod=the_bod & "<p><i>If your password expires on a Saturday or Sunday make sure you change it before the end of the day on Friday.</i>&nbsp;</p>" & vbCRLF
the_bod=the_bod & "<p>For assistance please call the helpdesk in the home office ext. 1711, branches dial 877-226-1244, then choose option <strong>#1</strong>.</p>" & vbCRLF
the_bod=the_bod & "<p>(This is a system-generated email)</p></font>" & vbCRLF
'wscript.echo(the_bod)
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "sender@yourdomain.com"
objEmail.Subject = "Your windows password is expiring!"
objEmail.To = tmp1
objEmail.BCC = "sysadmin@yourdomain.com"
objEmail.HTMLBody=the_bod
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "emailserver.yourdomain.com"
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

set objEmail = Nothing
stdout.write("Email sent to " & tmp1)

end if


end function
'******************************************************************************************************************
function send_summary

if strDebug = True then exit function

the_bod=the_bod & "<html><p><font size = '3'>Below please find the table listing accounts that " & vbCRLF
the_bod=the_bod & "the 'password expiring' emails were sent to " & NOW & vbCRLF
the_bod=the_bod & " because their domain account password's expiration date is within 2 days in the future and  " & vbCRLF
the_bod=the_bod & "not more than 2 days in the past, and not flagged as disabled in Active Directory. </p>" & vbCRLF
the_bod=the_bod & "<p>(This is a system-generated email)</p><br></font></html>" & vbCRLF
the_bod = the_bod & VBCrLF & strHTML
Set objEmail = CreateObject("CDO.Message")
'objEmail.AddAttachment strOutput_file & ".XLS"
objEmail.From = "sender@yourdomain.com"
objEmail.Subject = "Expiring passwords summary"
objEmail.To = "receiver1@yourdomain.com,receiver2@yourdomain.com"


objEmail.HTMLBody=the_bod
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "emailserver.yourdomain.com" 
objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
set objEmail = Nothing


end function

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial