Vista - Account Expiration Notice - Notify Manager

All,

Thanks for any help you can provide. I'm a novice at vbs scripting.
I've taken parts of existing scripts to create an Account Expiration
script. The intent is to find all accounts expiring in 14 days and
send a warning email to the Account's manager. I have all of the data
pieces of the script working and returning the appropriate data, but
I'm struggling with the piece for notifying the manager. I'm trying
to find a way to use the ouser.manager attribute which returns the CN=
name of the manager to get the manager's email address. I know there
must be a simple way to do this, but because of my inexperience I've
run into a brick wall. Below is the script. Right now I have the
notification piece turned off and just logging to a file.

Thanks,

Roland


'############################################################################
'#
'# Account Expiration Notice
'#
'# This script checks for user accounts that will exire
'# in a certian number of days and send notification email to the
manager.
'#
'############################################################################

'### VARS ###
'#

dtToday = Date

'# sScriptLogFile is the path of the log file for this script
sScriptLogFile = "C:\Scripts\AccountExpirationNotice.log"

'#
'###

'### Subs
'#

'---------------------------------------------------------------------------------------------------
' The WriteLog function writes a line to the log file and prepends the
time and date
'---------------------------------------------------------------------------------------------------
Function WriteLog(sLogLine)

sFullLogLine = now & " - " & sLogLine
oScriptLog.WriteLine (sFullLogLine)

End Function

'---------------------------------------------------------------------------------------------------
' The SendWrnEmail function sends the warning email that an account is
going to expire
'---------------------------------------------------------------------------------------------------
Function SendWrnEmail(sTo,sDisplayName,sUserName,iDays,dtExpire)

'Subject and body for the email

sWrnEmailSubject = "Account Expiration Notice - Temp /
Contractor : "
& oUser.givenname & " " & oUser.sn
sWrnEmailBody = swrnEmailBody & "XXXXX" & "," & vbCrLf & vbCrLf
sWrnEmailBody = sWrnEmailBody & oUser.givenname & " " &
oUser.sn &
"'s " & "account will expire in " & iDays & " days." & vbCrLf
sWrnEmailBody = sWrnEmailBody & "If you would like their access
to
continue, Please submit a helpdesk ticket to EMAILADDRESSHERE and
state the duration up to 90 days." & vbCrLf & vbCrLf
sWrnEmailBody = sWrnEmailBody & "Thank You," & vbCrLf
sWrnEmailBody = sWrnEmailBody & vbCrLf
sWrnEmailBody = sWrnEmailBody & "IT Tech Support"

Set oCDOSYSMail = WScript.CreateObject("CDO.Message")
Set oCDOSYSConf = WScript.CreateObject ("CDO.Configuration")

'SMTP server's name
oCDOSYSConf.Fields("http://schemas.microsoft.com/cdo/
configuration/
smtpserver") = "MAIL SERVER HERE"
'Port used by the SMTP server to send e-mail
oCDOSYSConf.Fields("http://schemas.microsoft.com/cdo/
configuration/
smtpserverport") = 25
'SMTP over the network instead of using the local SMTP service
pickup
directory
oCDOSYSConf.Fields("http://schemas.microsoft.com/cdo/
configuration/
sendusing") = 2
'Time-out duration
oCDOSYSConf.Fields("http://schemas.microsoft.com/cdo/
configuration/
smtpconnectiontimeout") = 60
oCDOSYSConf.Fields.Update

'Setting up e-mail and its configuration
Set oCDOSYSMail.Configuration = oCDOSYSConf
oCDOSYSMail.From = "FROM ADDRESS HERE"
oCDOSYSMail.To = sTo
oCDOSYSMail.Subject = sWrnEmailSubject
oCDOSYSMail.TextBody = sWrnEmailBody

'Send the email
oCDOSYSMail.Send

'Close the server mail Object
Set oCDOSYSMail = Nothing
Set oCDOSYSConf = Nothing

End Function


'---------------------------------------------------------------------------------------------------
' The CheckExpiration checks to see if the user's account is going to
expire soon, if it will then
' a notification email will be generated.
'---------------------------------------------------------------------------------------------------
Function CheckExpiration()

dtExpDate = oUser.AccountExpirationDate

'Get Days Until Account Expiration
iDays = DateDiff("d",dtToday,dtExpDate)


If iDays = -14167 Then

Else

If iDays <= 0 Then

sLogMsg = ouser.samaccountname & " --- " & "Is Already Expired"
Call WriteLog(sLogMsg)

Else

If iDays <= 14 AND > 0 Then

sLogMsg = oUser.Mail & "---" & oUser.samaccountname & " --- " & iDays
& " --- "
Call WriteLog(sLogMsg)
'Call SendWrnEmail (sTo,sDisplayName,sUserName,iDays,dtExpire)



End If
End If
End Function

'#
'###

'### Main ###
'#

Set oFSO = CreateObject("Scripting.FileSystemObject")

'Let see if the script's log file exists and if so lets open it for
appending, otherwise create and open
If oFSO.FileExists(sScriptLogFile) then
Set oScriptLog = oFSO.OpenTextFile(sScriptLogFile, 8)
Else
Set oScriptLog = oFSO.OpenTextFile(sScriptLogFile, 2, True)
End If

' Connect to LDAP and get all user accounts
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

'Lets get the correct Top level DN for our domain


strBase = "LDAP:// TOP LEVEL HERE"

strQuery = "SELECT AdsPath FROM '" & strBase & "' WHERE
objectCategory='person' and objectClass='user'"

objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False

sLogMsg = "Connecting to LDAP"
Call WriteLog(sLogMsg)

Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
sAdsPath = objRecordSet.Fields("AdsPath")
set oUser = GetObject(sAdsPath)

Call CheckExpiration()

objRecordSet.MoveNext
err.clear
Loop
wScript.Echo "Done!"
oScriptLog.Close

objConnection.Close

'#
'###

"vivah8t" <roland.brown@xxxxxx> wrote in message
news:a00eb1a4-5e96-4e74-9897-6f8ce1cd01c5@xxxxxxTo retrieve the Email address of the manager you must bind to the
corresponding object and retrieve the "mail" attribute (assuming this field
is populated). The "mail" attribute corresponds to the field labeled
"E-mail" on the "General" tab in ADUC. If you have Exchange you may need to
retrieve the multi-valued proxyAddresses attribute and use the one
designated as primary in the collection.

Binding to all user objects, plus all manager objects, can slow down the
script. It is more efficient to use ADO to retrieve all required attributes
of the users. In my example VBScript below I filter on all user accounts
that expire in the next 14 days. No need to bind to the user objects to
invoke the AccountExpirationDate property method. I use the accountExpires
attribute, which is Integer8 (a 64-bit number representing the expiration
date as the number of 100-nanosecond intervals since 12:00 AM Jan. 1, 1601).
I retrieve the DN of the manager and bind to the manager object to retrieve
the Email address. However, to minimize binding I keep track of the manager
email addresses in a dictionary object, so each manager need only be bound
once. This example script, which does not deal with emailing, follows:
===========
' AcctsAboutToExpire.vbs
' VBScript program to find accounts that will expire in the
' next 14 days.
Option Explicit

Dim objShell, lngBiasKey, lngTZBias
Dim adoConnection, adoCommand, objRootDSE, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery
Dim adoRecordset, strName, strManager
Dim dtmCritical, lngSeconds, str64Bit
Dim objDate, dtmExpire, objManager, strEmail
Dim objList

' 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

' Create dictionary object of manager email addresses.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Determine critical date 14 days in future.
dtmCritical = DateAdd("d", 14, Now())

' Convert to UTC.
dtmCritical = DateAdd("n", lngTZBias, dtmCritical)

' Convert to seconds since 1/1/1601
lngSeconds = DateDiff("s", #1/1/1601#, dtmCritical)

' Convert to 100-nanosecond intervals
str64Bit = CStr(lngSeconds) & "0000000"

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on user objects that expire in next 14 days.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(accountExpires<=" & str64Bit & ")(!accountExpires=0))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,manager,accountExpires"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("sAMAccountName").Value
strManager = adoRecordset.Fields("manager").Value & ""
If (strManager <> "") Then
' Check if manager in dictionary object.
If (objList.Exists(strManager) = True) Then
' Retrieve email address from dictionary object.
strEmail = objList(strManager)
Else
' Bind to manager, retrieve email address
' and add to dictionary object.
Set objManager = GetObject("LDAP://" & strManager)
strEmail = objManager.mail
objList.Add strManager, strEmail
End If
Else
strEmail = ""
End If
Set objDate = adoRecordset.Fields("accountExpires").Value
dtmExpire = Integer8Date(objDate, lngTZDate)
Wscript.Echo strName & "," & dtmExpire & "," & strEmail
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close

Function Integer8Date(ByVal objDate, ByVal 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 ridiculously huge.
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
=======
In this example I retrieve the sAMAcountName of each user, which is the
"pre-Windows 2000 logon name". You can add sn and givenName to the comma
delimited list of attribute values to retrieve. This would be much more
efficient than binding to the user objects. This should give you all the
information you need to either write to a log or create the email messages.

For more on using ADO to retrieve information form AD see this link:

http://www.rlmueller.net/ADOSearchTips.htm

For more on Integer8 attributes, see this link:

http://www.rlmueller.net/Integer8Attributes.htm

I have a discussion of the quirks of the accountExpires attribute and the
AccountExpirationDate property method here:

http://www.rlmueller.net/AccountExpires.htm

In particular, there are cases where AccountExpirationDate raises an error
(if the user never had an expiration date).

If you need to use proxyAddresses, you must enumerate this multi-value
attribute and find the one designated as the primary address. It is assumed
that will be the address that starts with "SMTP:" in all caps. For example:
======
....
Dim arrEmails, strAddress

Set objManager = GetObject("LDAP://" & strManager)
' Retrieve proxyAddresses. Trap error if empty.
strEmail = ""
On Error Resume Next
arrEmails = objManager.GetEx("proxyAddresses")
If (Err.Number = 0) Then
On Error GoTo 0
For Each strAddress In arrEmails
If (Left(strAddress, 5) = "SMTP:") Then
strEmail = Mid(strAddress, 6)
Exit For
End If
Next
Next
On Error GoTo 0
objList.Add strManager, strEmail
==========
Notice I declared the new variables in a Dim statement, as required by
"Option Explicit". I hope this helps.

--
Richard Mueller
MVP Directory Services
Hilltop Lab - http://www.rlmueller.net
--