Monthly Archives: October 2006

NotifyExpiringADUsers

This script searches your Active Directory for accounts that are about to expire and then sends a warning e-mail to that user´s e-mail address in regular intervals.
The first warning is sent 14 days before expiry date, the second warning is sent 7 days before expiry date and the last warning is sent the day before the account expires.
The script also sends a report on which users that expires the same day to an e-mail address of your choosing.

'=================================================================================================== 
'NotifyExpiringADUsers.vbs
'
'Created by: Goran Tornqvist. 
'This script is freeware, do what you like with it ;)
' 
'Description: 
'This script searches your Active Directory for accounts that are about to expire
'and then sends a warning e-mail to that user´s e-mail address in regular intervals.
'The first warning is sent 14 days before expiry date, the second warning is sent 7 days before expiry date and
'the last warning is sent the day before the account expires.<br/>
'The script also sends a report on which users that expires the same day to an e-mail address of your choosing.
'===================================================================================================

Option Explicit

Const EVENT_SUCCESS	= 0
Const EVENT_ERROR	= 1
Const EVENT_WARNING	= 2
Const EVENT_INFORMATION	= 4

Sub SendWarningMessage(strToEmail, GivenName, AccountName, ExpireDate, strWarning)

	Dim strSubject, strMessage, sch, cdoConfig, cdoMessage

	strSubject = "Your account expires in " & strWarning
	strMessage = "Hello " & GivenName & "," & vbCrLf & _
			"Your windows account " & AccountName & " is expiring " & strWarning & " (" & ExpireDate & ")." & vbCrLf & _
			"To prolong your account you need to contact Human Resources or your team leader." & vbCrLf & _
			vbCrLf & _
			"______________________________" & vbCrLf & _
			"Best Regards" & vbCrLf & _
			"IT Support" & vbCrLf

	sch = "http://schemas.microsoft.com/cdo/configuration/"
 	Set cdoConfig = CreateObject("CDO.Configuration") 
 	With cdoConfig.Fields 
		.Item(sch & "sendusing") = 2 ' cdoSendUsingPort 
		.Item(sch & "smtpserver") = "mail.yourisp.com"
		.update 
	End With 

	Set cdoMessage = CreateObject("CDO.Message") 

	'Importance High
	cdoMessage.Fields.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High"
	cdoMessage.Fields.Item("urn:schemas:mailheader:X-Priority") = 2
	cdoMessage.Fields.Item("urn:schemas:httpmail:importance") = 2
	cdoMessage.Fields.Update

	With cdoMessage 
		Set .Configuration = cdoConfig 
		.From = "itsupport@yourcompany.com"
		.To = strToEmail
		.Subject = strSubject 
		.TextBody = strMessage
		.Send 
	End With 

	Set cdoMessage = Nothing 
	Set cdoConfig = Nothing

End Sub

Dim strMember, strContainer, strFileName
Dim objGroup, objRootDSE, objConnection, objShell
Dim objFS, objFile, WShell, strEmailGroup, strUser, objRecordSet, strEmail, objUser, strQuery, strBase, strFilter, strAttributes

Set objShell = CreateObject("WScript.Shell")

On Error Resume Next

Dim BaseValue : BaseValue = 11644473600 '0000000 away with last numbers
'116,444,736,000,000,000 = number of 100-nanosecond intervals between
'1970-01-01 00:00 gmt and Jan 1, 1601
'AccountExpirationDate is 100 nanossec intervals since 1601-01-01 GMT

Dim strExpiringUsers, FromDate, ToDate
Dim strWarning1, FromDate1, ToDate1, ExpireDate1
Dim strWarning2, FromDate2, ToDate2, ExpireDate2
Dim strWarning3, FromDate3, ToDate3, ExpireDate3

strWarning1 = "in 14 days"
ExpireDate1 = Date()+14
FromDate1 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate1) & " 23:59:59")) & "0000000"
ToDate1 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate1) & " 00:00:00")) & "0000000"

strWarning2 = "in 7 days"
ExpireDate2 = Date()+7
FromDate2 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate2) & " 23:59:59")) & "0000000"
ToDate2 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate2) & " 00:00:00")) & "0000000"

strWarning3 = "tomorrow"
ExpireDate3 = Date()+1
FromDate3 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate3) & " 23:59:59")) & "0000000"
ToDate3 = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(ExpireDate3) & " 00:00:00")) & "0000000"

Const strDNSDomain = "DC=youractivedirectorydomain,DC=com"

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

'Send first-warning e-mails

strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&" & _
	"(objectCategory=person)" & _
	"(objectClass=user)" & _
	"(&(!accountExpires=9223372036854775807)(!accountExpires=0))(accountExpires<=" & FromDate1 & ")(accountExpires>=" & ToDate1 & ")" & _
	")"

strAttributes = "sAMAccountName,givenName,accountExpires,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

Set objRecordSet = objConnection.Execute(strQuery)

Do Until objRecordSet.EOF

	If objRecordSet.Fields("mail") <> "" AND InStr(objRecordSet.Fields("mail"), "@") > 0 Then
		SendWarningMessage objRecordSet.Fields("mail"), objRecordSet.Fields("givenName"), objRecordSet.Fields("sAMAccountName"), ExpireDate1, strWarning1
	End If
	objRecordSet.MoveNext
Loop

'Send second-warning e-mails

strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&" & _
	"(objectCategory=person)" & _
	"(objectClass=user)" & _
	"(&(!accountExpires=9223372036854775807)(!accountExpires=0))(accountExpires<=" & FromDate2 & ")(accountExpires>=" & ToDate2 & ")" & _
	")"

strAttributes = "sAMAccountName,givenName,accountExpires,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

Set objRecordSet = objConnection.Execute(strQuery)

Do Until objRecordSet.EOF

	If objRecordSet.Fields("mail") <> "" AND InStr(objRecordSet.Fields("mail"), "@") > 0 Then
		SendWarningMessage objRecordSet.Fields("mail"), objRecordSet.Fields("givenName"), objRecordSet.Fields("sAMAccountName"), ExpireDate2, strWarning2
	End If
	objRecordSet.MoveNext
Loop

'Send last-warning e-mails

strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&" & _
	"(objectCategory=person)" & _
	"(objectClass=user)" & _
	"(&(!accountExpires=9223372036854775807)(!accountExpires=0))(accountExpires<=" & FromDate3 & ")(accountExpires>=" & ToDate3 & ")" & _
	")"

strAttributes = "sAMAccountName,givenName,accountExpires,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

Set objRecordSet = objConnection.Execute(strQuery)

Do Until objRecordSet.EOF

	If objRecordSet.Fields("mail") <> "" AND InStr(objRecordSet.Fields("mail"), "@") > 0 Then
		SendWarningMessage objRecordSet.Fields("mail"), objRecordSet.Fields("givenName"), objRecordSet.Fields("sAMAccountName"), ExpireDate3, strWarning3
	End If
	objRecordSet.MoveNext
Loop

FromDate = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(Date) & " 23:59:59")) & "0000000"
ToDate = (BaseValue + DateDiff("s", CDate("1970/01/01 00:00:00"), CStr(Date) & " 00:00:00")) & "0000000"

'Send a report on which users that are expiring today.

strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(&" & _
	"(objectCategory=person)" & _
	"(objectClass=user)" & _
	"(&(!accountExpires=9223372036854775807)(!accountExpires=0))(accountExpires<=" & FromDate & ")(accountExpires>=" & ToDate & ")" & _
	")"

strAttributes = "sAMAccountName,cn,accountExpires,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

Set objRecordSet = objConnection.Execute(strQuery)

Do Until objRecordSet.EOF

	strExpiringUsers = strExpiringUsers & objRecordSet.Fields("cn") & " (" & objRecordSet.Fields("sAMAccountName") & ")" & vbCrLf
	objRecordSet.MoveNext
Loop

If strExpiringUsers <> "" Then

	Dim strSubject, strMessage, sch, cdoConfig, cdoMessage

	strSubject = "AD-accounts expiring " & Date
	strMessage = "The following AD-accounts has ""account expires"" " & Date & ":" & vbCrLf & vbCrLf & strExpiringUsers

	sch = "http://schemas.microsoft.com/cdo/configuration/"
 	Set cdoConfig = CreateObject("CDO.Configuration") 
 	With cdoConfig.Fields 
		.Item(sch & "sendusing") = 2 ' cdoSendUsingPort 
		.Item(sch & "smtpserver") = "mail.yourisp.com"
		.update 
	End With 

	Set cdoMessage = CreateObject("CDO.Message") 

	With cdoMessage 
		Set .Configuration = cdoConfig 
		.From = "itsupport@yourcompany.com"
		.To = "itsupport@yourcompany.com"
		.Subject = strSubject
		.TextBody = strMessage
		.Send 
	End With 

	Set cdoMessage = Nothing 
	Set cdoConfig = Nothing
End If

If Err.Number <> 0 Then
	objShell.LogEvent EVENT_ERROR, "NotifyExpiringADUsers.vbs" & vbCrLf & "An error occurred." & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf
Else
	objShell.LogEvent EVENT_INFORMATION, "NotifyExpiringADUsers.vbs" & vbCrLf & "Execution Successful." & vbCrLf & strMessage & vbCrLf
End If

Wscript.Quit