"vivah8t" <roland.brown@xxxxxx> wrote in message
news:a00eb1a4-5e96-4e74-9897-6f8ce1cd01c5@xxxxxx
> 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
>
> '#
> '### To 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
--