'This VBScript will run aggainst the ActiveDirectory Domain the executing User is a Member of.
'The executing User does not need to be an Domain-Administrator of any kind, a simply User is able to read the necessary information from ActiveDirectory
'
'Please configure the following Options - the Script does not accept or expect any Start-Parameter
'
'Version 2.2 - 04/12/2017: Florian Rossmark
'---------------------------------- START OPTIONS ----------------------------------
Const strSMTPServer = "relay.domain.com" 'SMTP Mail-Server to use
Const intSMTPServerPort = 25 'SMTP Mail-Server connection Port Number
Const strFrom = "pwdscript@domain.com" 'SMTP Mail From Address
Const strToAdmin = "helpdesk@domain.com" 'SMTP Mail To Address for Administrator
Const strAdminMailSubject = "Company Name - User Password Script Results to Admin" 'Subject for Mail to Admin
Const strUserMailSubjectExpired = "Your password has expired!" 'Subject for Mail to User when Password is expired
Const strUserMailSubjectWillExpire = "Your password will expire in REPLACEWITHDAYS days" 'Subject for Mail to User when Password will expire - the exact word REPLACEWITHDAYS will be replaced by the days left value
Const strBodyURL = "file://C:/scripts/PWD/PWDExpire.html" 'URL or full file-path (HTML) to import for Body, the entire content of this URL/FILE will be imported to the Body of the email and should explain ways how to change the password
Const strAttachment = "" 'full File-Path to an attachment for the email to the users / leave empty if no attachment
Const strLDAPSortColumn = "pwdLastSet" 'per default: pwdLastSet / sort column for LDAP query
Const intStartWithPWexpiresInDays = 5 'If the Passwords expires in days N or less, the script will inform the user
Const bolIgnoreDisabledAccounts = True 'Disabled accounts should always be ignored
Const bolInformAdminAboutPWexpires = True 'This will inform the Admin about expiring passwords
Const bolInformAdminAboutPWisExpired = True 'This will inform the Admin about accounts with expired Passwords
Const bolInformAdminAboutPWneverExpires = True 'This will inform the Admin about accounts with password set to never expire
Const bolInformAdminAboutUserCantChangePW = True 'This will inform the Admin about users who are not allowed to change their password
Const bolInformAdminAboutAccountDisabled = True 'This will inform the Admin about disabled accounts found - this would have been done in ADS by an administrator
Const bolInformAdminAboutExpiredUserAccount = True 'This will inform the admin if the User Account has an expiration date and the account is expired
Const bolInformAdminAboutAccountWithoutEMail = True 'This will inform the Admin about accounts without a set email address
Const bolInformAdminAboutStillGoodPasswords = True 'This will inform the Admin about Users/Passwords that are still valid
Const bolInformAdminAboutIgnoredUsersExcludedByGroup = True 'This will inform the Admin about Users that have been ignored by the strGroupsExclude filter
'Please Note: Status Account Locked will not be checked, this should be corrected automatically by the Default Security GPO instead (will be in most cases by default)
'Filter Priority 1 - only Users in those OU Paths will be processed
'Use LDAP DN like: "OU=Folder,OU=Folder,DC=Domain,DC=local", you do not need to include the DC=Domain,DC=local - the Script will add this information if necessary
'Use | (pipe) if you want to add more then one LDAP DN Path
'Leave empty ("") to disable this filter
Const strSearchOUs = "" '"OU=Users,OU=Site,DC=domain,DC=local"
'Filter Priority 2 - if the User Object is still not excluded, this Group Exclude filter will be applied
'If the user is member of one of those groups (if multiple groups are defined), he will be ignored
'Use | (pipe) if you want to add more then one GroupName
'Leave empty ("") to disable this filter
'Example: "Group Number1|GroupNumber2"
Const strGroupsExclude = "No Password notification emails"
'Filter Priority 3 - if the User Object is still not excluded, this Group Include filter will be applied
'The user has to be a member of one of those groups (if multiple groups are defined)
'Use | (pipe) if you want to add more then one GroupName
'Leave empty ("") to disable this filter
'Example: "Group Number1|GroupNumber2"
Const strGroupsInclude = ""
Const bolDebug = True 'Set TRUE for Script-Output, highly recommended to execute the Script in CMD with CSCRIPT <ScriptName>
Const bolAttachDebugToAdminMail = False 'The Debug Output will be attached to the Admin-Mail (independent from bolDebug)
Const bolTestDebugOutputToConsoleOnly = False 'This will disable the Mail.Send - only output to the CMD will be generated, please enable bolDebug
Const bolRedirectMailToAdmin = True 'This will redirect all Mails to the Admin, instead of sending them to the User - the Subject line will include the User-Mail Address in this case
Const bolAdminMailOnly = False 'This will send the Admin-Mail only, no User Mail will be generated
'---------------------------------- END OPTIONS ----------------------------------
'---------------------------------- Script starts here ----------------------------------
'---------------------------------- please do not modify after this line ----------------------------------
'Reference: https://msdn.microsoft.com/en-us/library/aa772300(v=vs.85).aspx
Const ADS_UF_DONT_EXPIRE_PASSWD = 65536
Const ADS_UF_PASSWD_CANT_CHANGE = 64
Const ADS_UF_PASSWORD_EXPIRED = 8388608
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = 6
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"
'A few Global Variables for the Admin-Mail
Dim strAdminPWexpires, strAdminPWisExpired, strAdminPWneverExpires, strAdminUserCantChangePW, strAdminAccountDisabled, strAdminExpiredUserAccount, strAdminAccountWithoutEMail, strAdminPWstillGood, strAdminIgnoredUsersExcludedByGroup
Dim strAdminErrorUsers
Dim strAdminDebug
SearchADS() 'Let's Start the actual process
'starts the actual search procedure - in a sub so it is easier to keep overview of the script
Sub SearchADS()
Dim objADSRoot, objADSDomain, objADSConnection, objADSCommand, objMaxPWDage, objUser
Dim intMaxPWDage, intDaysLeft
Dim bolProcessUser
Dim cntArray
Dim arrSearchOUs, arrGroupsExclude, arrGroupsInclude
Dim iADSCommand
Dim strFirstFoundGroupMembership
arrGroupsExclude = Split(strGroupsExclude, "|")
arrGroupsInclude = Split(strGroupsInclude, "|")
'Connect to ADS and get Users
Set objADSRoot = GetObject("LDAP://rootDSE")
Set objADSDomain = GetObject("LDAP://" & objADSRoot.Get("defaultNamingContext"))
Set objMaxPWDage = objADSDomain.Get("maxPwdAge") 'please note, this script can't obey the latest ADS multible password GPO rules, it will only follow the standard with only one password rule
intMaxPWDage = CCur((objMaxPWDage.HighPart * 2 ^ 32) + objMaxPWDage.LowPart) / CCur(-864000000000)
If Not intMaxPWDage > 0 Then 'Passwords won't expire at all
ScriptDebug("intMaxPWDage is set to: " & intMaxPWDage & " - Script stopped")
SendEmailNotification True, "", True, 0, "intMaxPWDage is incorrect, please check ADS configuration. Script aborded" 'Inform that there is no expiration configuration in Active Directory
Exit Sub 'Stop the Sub / End the Search
End If
Set objADSConnection = CreateObject("ADODB.Connection")
objADSConnection.Open "Provider=ADsDSOObject;"
Set objADSCommand = CreateObject("ADODB.Command")
objADSCommand.ActiveConnection = objADSConnection
If Not Len(strSearchOUs) > 0 Then
ReDim arrSearchOUs(0) 'we still need an array to run the For Next
arrSearchOUs(0) = ""
Else
arrSearchOUs = Split(strSearchOUs, "|")
End If
For iADSCommand = 0 To UBound(arrSearchOUs) 'we already filter OUs if necessary - filter priority 1
If Len(strSearchOUs) > 0 Then 'we need everytime a new objADSDomain to set the Filter based on the OU
If Not Right(arrSearchOUs(iADSCommand),Len(objADSRoot.Get("defaultNamingContext"))) = objADSRoot.Get("defaultNamingContext") Then
If Not Right(arrSearchOUs(iADSCommand),1) = "'" Then
arrSearchOUs(iADSCommand) = arrSearchOUs(iADSCommand) & ","
End If
arrSearchOUs(iADSCommand) = arrSearchOUs(iADSCommand) & objADSRoot.Get("defaultNamingContext")
End If
ScriptDebug("Searching LDAP Path: " & arrSearchOUs(iADSCommand))
Set objADSDomain = GetObject("LDAP://" & arrSearchOUs(iADSCommand))
End If
'samAccountType=805306368 / this is the correct value for USERS only - a search for the ObjectClass USER will also list Contacts
objADSCommand.CommandText = "<" & objADSDomain.ADsPath & ">;(&(samAccountType=805306368));userAccountControl,sAMAccountName,givenName,sn,mail,distinguishedName,lockoutTime;subtree"
objADSCommand.Properties("Sort on") = strLDAPSortColumn
Set rs = objADSCommand.Execute
If Not rs.EOF Then
Do While Not rs.EOF
ScriptDebug("") 'Empty Line before each run for easier to read output
ScriptDebug("PROCESSING USER: " & NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ")")
intDaysLeft = 0
bolProcessUser = True
'Priority 2 - Exclude the following groups
If Len(strGroupsExclude) > 0 Then
strFirstFoundGroupMembership = "" 'just to make sure, lets clean the variable
If IsUserInGroup(rs("distinguishedName"), arrGroupsExclude, strFirstFoundGroupMembership) Then 'User is Member of the Group, we ignore him
ScriptDebug("..USER IS MEMBER OF EXCLUDED GROUP: " & strFirstFoundGroupMembership & " - IGNORING USER")
bolProcessUser = False
'old info - 'We don't inform the Admin in this case, would be done over the Debug Info
If bolInformAdminAboutIgnoredUsersExcludedByGroup Then
strAdminIgnoredUsersExcludedByGroup = AddAdminInfoTo(strAdminIgnoredUsersExcludedByGroup, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage) * -1)), True) 'Add to Admin Info
End If
End If
End If
'Priority 3 - Include the following groups
If bolProcessUser Then 'do we still go on with this User?
If Len(strGroupsInclude) > 0 Then
strFirstFoundGroupMembership = "" 'just to make sure, lets clean the variable
If Not IsUserInGroup(rs("distinguishedName"), arrGroupsInclude, strFirstFoundGroupMembership) Then 'User is Member of the Group, we ignore him
ScriptDebug("..USER IS NOT A MEMBER OF ANY OF THE INCLUDED GROUPS - IGNORING USER")
bolProcessUser = False
'old info - 'We don't inform the Admin in this case, would be done over the Debug Info
If bolInformAdminAboutIgnoredUsersExcludedByGroup Then
strAdminIgnoredUsersExcludedByGroup = AddAdminInfoTo(strAdminIgnoredUsersExcludedByGroup, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage) * -1)), True) 'Add to Admin Info
End If
Else 'User will be noramlly proccessed, we still inform about it in the Script-Debug
ScriptDebug("..USER IS MEMBER OF INCLUDED GROUP: " & strFirstFoundGroupMembership & " - PROCESSING USER")
End If
End If
End If
'Priority 4 - disabled account? this would have been done by an administrator
If bolProcessUser Then 'do we still go on with this User?
If IsAccountDisabled(rs("distinguishedName")) Then 'Account is disabled
ScriptDebug("..DISABLED USER ACCOUNT FOUND")
If bolIgnoreDisabledAccounts Then 'do we ignore this Account?
bolProcessUser = False
End If
If bolInformAdminAboutAccountDisabled Then
'strAdminAccountDisabled = AddAdminInfoTo(strAdminAccountDisabled, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ")") 'Add to Admin Info
strAdminAccountDisabled = AddAdminInfoTo(strAdminAccountDisabled, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), ""), True) 'Add to Admin Info
End If
End If
End If
'Priority 5 - Will User Account expire? (we only check if it is expired, if yes we take action)
If bolProcessUser Then 'do we still go on with this User?
If IsUserAccountExpired(rs("distinguishedName"), dtmExpiration) Then
bolProcessUser = False
ScriptDebug("..USER ACCOUNT IS EXPIRED SINCE: " & dtmExpiration)
If bolInformAdminAboutExpiredUserAccount Then
'strAdminExpiredUserAccount = AddAdminInfoTo(strAdminExpiredUserAccount, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ") - User expired since: " & dtmExpiration) 'Add to Admin Info
strAdminExpiredUserAccount = AddAdminInfoTo(strAdminExpiredUserAccount, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat(dtmExpiration), True) 'Add to Admin Info
End If
End If
End If
'Priority 6 - password never expires? this would have been done by an administrator
If bolProcessUser Then 'do we still go on with this User?
If PasswordDoesExpire(rs("userAccountControl")) Then 'Password does not expire
ScriptDebug("..USER WITH PASSWORD WILL NOT EXPIRE FOUND")
bolProcessUser = False
If bolInformAdminAboutPWneverExpires Then
'strAdminPWneverExpires = AddAdminInfoTo(strAdminPWneverExpires, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ")") 'Add to Admin Info
strAdminPWneverExpires = AddAdminInfoTo(strAdminPWneverExpires, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), ""), True) 'Add to Admin Info
End If
End If
End If
'Priority 7 - User can't even change the password? this would have been done by an administrator
If bolProcessUser Then 'do we still go on with this User?
If UserCantChangePassword(rs("distinguishedName")) Then 'User can't change Password
ScriptDebug("..USER WITH CAN'T CHANGE PASSWORD FOUND")
bolProcessUser = False
If bolInformAdminAboutUserCantChangePW Then
'strAdminUserCantChangePW = AddAdminInfoTo(strAdminUserCantChangePW, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ")") 'Add to Admin Info
strAdminUserCantChangePW = AddAdminInfoTo(strAdminUserCantChangePW, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), ""), True) 'Add to Admin Info
End If
End If
End If
'Priority 8 - User does not have an EMail Address? can't inform User if PW is about to expire what shall we do?
If bolProcessUser Then 'do we still go on with this User?
If Not Len(NZ(rs("mail"), "")) > 0 Then 'User is missing email address
ScriptDebug("..USER WITHOUT EMAIL ADDRESS FOUND")
bolProcessUser = False
If bolInformAdminAboutAccountWithoutEMail Then
'strAdminAccountWithoutEMail = AddAdminInfoTo(strAdminAccountWithoutEMail, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ") - Days Left: " & (GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage) * -1)) 'Add to Admin Info
strAdminAccountWithoutEMail = AddAdminInfoTo(strAdminAccountWithoutEMail, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage) * -1)), True) 'Add to Admin Info
End If
End If
End If
'Priority 9 - now we check the Password Age and take action
If bolProcessUser Then 'do we still go on with this User?
If PasswordIsExpired(rs("userAccountControl")) Then 'The Password is already expired? We need to take action / this will be double checked later on with a calculation
ScriptDebug("..PASSWORD IS EXPIRED")
SendEmailNotification False, NZ(rs("mail"), ""), True, 0, "" 'Inform the USER about the expired Password
If bolInformAdminAboutPWisExpired Then
'strAdminPWisExpired = AddAdminInfoTo(strAdminPWisExpired, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ")") 'Add to Admin Info
strAdminPWisExpired = AddAdminInfoTo(strAdminPWisExpired, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage) * -1)), True) 'Add to Admin Info
End If
Else 'Password is not expired yet, how many days does the User have left?
Set objUser = GetObject("LDAP://" & rs("distinguishedName"))
intDaysLeft = GetPWDaysLeft(rs("distinguishedName"), NZ(rs("givenName"), ""), NZ(rs("sn"), ""), NZ(rs("sAMAccountName"), ""), intDaysLeft, intMaxPWDage)
If intDaysLeft <= 0 Then 'we have a number of days left
If intStartWithPWexpiresInDays >= (intDaysLeft * -1) Then 'User is to be informed, his days left are less then defined
ScriptDebug("..PASSWORD FOR USER WILL EXPIRE IN: " & (intDaysLeft * -1) & " DAYS")
SendEmailNotification False, NZ(rs("mail"), ""), False, (intDaysLeft * -1), "" 'Inform the USER that the Password will expire
If bolInformAdminAboutPWexpires Then
'strAdminPWexpires = AddAdminInfoTo(strAdminPWexpires, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ") - Days Left: " & (intDaysLeft * -1)) 'Add to Admin Info
strAdminPWexpires = AddAdminInfoTo(strAdminPWexpires, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((intDaysLeft * -1)), True) 'Add to Admin Info
End If
Else 'User has more days left then needed by Script Configuration
'we do not need to take action - we do not even send Mail to the Admin
ScriptDebug("..USER PASSWORD IS STILL GOOD - DAYS LEFT: " & (intDaysLeft * -1))
If bolInformAdminAboutStillGoodPasswords Then
'strAdminPWstillGood = AddAdminInfoTo(strAdminPWstillGood, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ") - Days Left: " & (intDaysLeft * -1)) 'Add to Admin Info
strAdminPWstillGood = AddAdminInfoTo(strAdminPWstillGood, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((intDaysLeft * -1)), True) 'Add to Admin Info
End If
End If
Else 'Password is already expired and needs to be changed now / second check, first one might not give the needed information
ScriptDebug("..PASSWORD IS EXPIRED FOR: " & (intDaysLeft * -1) & " DAYS")
SendEmailNotification False, NZ(rs("mail"), ""), True, 0, "" 'Inform the USER about the expired Password
If bolInformAdminAboutPWisExpired Then
'strAdminPWisExpired = AddAdminInfoTo(strAdminPWisExpired, NZ(rs("givenName"), "") & " " & NZ(rs("sn"), "") & " (" & NZ(rs("sAMAccountName"), "") & ") - Days expired: " & (intDaysLeft * -1)) 'Add to Admin Info
strAdminPWisExpired = AddAdminInfoTo(strAdminPWisExpired, NZ(rs("givenName"), "") & "</td><td>" & NZ(rs("sn"), "") & "</td><td>" & NZ(rs("sAMAccountName"), "") & "</td><td class=""right"">" & AdminInfoDaysLeftHTMLFormat((intDaysLeft * -1)), True) 'Add to Admin Info
End If
End If
Set objUser = Nothing 'to make sure the Object is release
End If
End If
rs.MoveNext
Loop
End If
Set rs = Nothing
Next 'Next from arrSearchOUs
Set objADSCommand = Nothing
Set objADSConnection = Nothing
Set objADSDomain = Nothing
Set objADSRoot = Nothing
ScriptDebug("")
ScriptDebug("SCRIPT ENDED SUCCESSFULLY => Sending Admin Mail")
SendEmailNotification True, "", True, 0, GenerateAdminMailBody 'Send the final admin notification with the requested information
End Sub
'Function returns days left for Password of User-Object (uses default Value intDaysLeft)
Function GetPWDaysLeft(strDistinguishedName, strGivenName, strSN, strsAMAccountName, intDaysLeft, intMaxPWDage)
Dim objUser
Set objUser = GetObject("LDAP://" & strDistinguishedName)
On Error Resume Next
'intDaysLeft will be negative, like a countdown, T minus DAYS
intDaysLeft = DateDiff("d", objUser.PasswordLastChanged, Now) - intMaxPWDage
If Err Then
If Err.Number = &h8000500d Then 'PWD was just changed
intDaysLeft = intMaxPWDage
ScriptDebug("..USER PASSWORD WAS JUST CHANGED")
'we don't send any Mails about this
Else 'unexpexted Error occured - this shouldn't happen at all!
ScriptDebug("..UNEXPECTED ERROR (UserPasswordLastChanged)")
'strAdminErrorUsers = AddAdminInfoTo(strAdminErrorUsers, strGivenName & " " & strSN & " (" & strsAMAccountName & ")") 'Add to Admin Info
strAdminErrorUsers = AddAdminInfoTo(strAdminErrorUsers, strGivenName & "</td><td>" & strSN & "</td><td>" & strsAMAccountName, True) 'Add to Admin Info
End If
End If
Err.Clear
On Error Goto 0
Set objUser = Nothing
GetPWDaysLeft = Round(intDaysLeft, 0)
End Function
Function IsUserAccountExpired(distinguishedName, dtmExpirationDate)
Dim bolReturn
Dim objUser
Dim dtmAccountExpiration
bolReturn = False
If NZ(distinguishedName, "") <> "" Then
Set objUser = GetObject("LDAP://" & distinguishedName)
On Error Resume Next
dtmAccountExpiration = objUser.AccountExpirationDate
If Err.Number = -2147467259 Or dtmAccountExpiration = "1/1/1970" Then 'Account has no expiration date specified
'we do nothing - not even a debug message
Else 'Account has expireation date
If DateDiff("d", dtmAccountExpiration, Now) > 0 Then
bolReturn = True
dtmExpirationDate = dtmAccountExpiration
End If
End If
On Error Goto 0
Set objUser = Nothing
End If
IsUserAccountExpired = bolReturn
End Function
'Is the User Member of one of the Groups in the Array? Give back first GroupName found if possible
Function IsUserInGroup(distinguishedName, arrGroups, FirstFoundGroupMembership)
Dim objUser, objGroup
Dim i
Dim strGroupName
Dim bolFound
bolFound = False
If NZ(distinguishedName, "") <> "" Then
Set objUser = GetObject("LDAP://" & distinguishedName)
On Error Resume Next
For Each objGroup In objUser.GetEx("memberOf")
strGroupName = Split(objGroup,",")(0)
strGroupName = Right(strGroupName, (Len(strGroupName)-3))
For i = 0 To UBound(arrGroups)
If LCase(strGroupName) = LCase(arrGroups(i)) Then
bolFound = True
FirstFoundGroupMembership = strGroupName
IsUserInGroup = True
Exit For
End If
Next
If bolFound Then
Exit For
End If
Next
On Error Goto 0
Set objUser = Nothing
Else
IsUserInGroup = False 'couldn't find User distinguishedName - not really possible
End If
End Function
'Is the Password Expired?
Function PasswordIsExpired(userAccountControl)
If NZ(userAccountControl, "") <> "" Then
If ADS_UF_PASSWORD_EXPIRED And userAccountControl Then
PasswordIsExpired = True
Else
PasswordIsExpired = False
End If
Else
PasswordIsExpired = False
End If
End Function
'Is the User able to change to Password?
Function UserCantChangePassword(distinguishedName)
Dim bolReturn
Dim objUser, objSD, objDACL, objACE
bolReturn = False
If NZ(distinguishedName, "") <> "" Then
On Error Resume Next
Set objUser = GetObject("LDAP://" & distinguishedName)
Set objSD = objUser.Get("nTSecurityDescriptor")
Set objDACL = objSD.DiscretionaryAcl
For Each objACE in objDACL
If objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT And LCase(objACE.ObjectType) = CHANGE_PASSWORD_GUID Then
bolReturn = True
Exit For
End If
Next
Set objDACL = Nothing
Set objSD = Nothing
Set objUser = Nothing
On Error Goto 0
End If
UserCantChangePassword = bolReturn
End Function
'Does the Account PW expire or not?
Function PasswordDoesExpire(userAccountControl)
If NZ(userAccountControl, "") <> "" Then
If ADS_UF_DONT_EXPIRE_PASSWD And userAccountControl Then
PasswordDoesExpire = True
Else
PasswordDoesExpire = False
End If
Else
PasswordDoesExpire = False
End If
End Function
'Account Disabled or not
Function IsAccountDisabled(distinguishedName)
Dim bolReturn
Dim objUser
bolReturn = False
If NZ(distinguishedName, "") <> "" Then
On Error Resume Next
Set objUser = GetObject("LDAP://" & distinguishedName)
bolReturn = objUser.AccountDisabled
Set objUser = Nothing
On Error Goto 0
End If
IsAccountDisabled = bolReturn
End Function
'NZ equivalent to VBA
Function NZ(Value,alternativeValue)
If IsNull(Value) Then
NZ = alternativeValue
Else
NZ = Value
End If
End Function
'Adds the Information as needed to the specified Variable as a new Line and returns the complete new string
Function AddAdminInfoTo(CurrentString, NewTextLine, IsTable)
If Not Len(NZ(CurrentString, "")) > 0 Then
'AddAdminInfoTo = NewTextLine
If Not IsTable Then
AddAdminInfoTo = NewTextLine
Else
AddAdminInfoTo = CurrentString & "<tr><td>" & Replace(NewTextLine, vbNewLine, "") & "</td></tr>"
End If
Else
'AddAdminInfoTo = CurrentString & vbNewLine & NewTextLine
If Not IsTable Then
AddAdminInfoTo = CurrentString & vbNewLine & NewTextLine
Else
AddAdminInfoTo = CurrentString & "<tr><td>" & Replace(NewTextLine, vbNewLine, "") & "</td></tr>"
End If
End If
End Function
'Reformatts the Days-Left into a special div tag if it is negative/positive
Function AdminInfoDaysLeftHTMLFormat(DaysLeft)
If DaysLeft > 0 Then
AdminInfoDaysLeftHTMLFormat = "<div class=""dayspositive"">" & DaysLeft & "</div>"
Else
AdminInfoDaysLeftHTMLFormat = "<div class=""daysnegative"">" & DaysLeft & "</div>"
End If
End Function
'Generates the Mail-Body for the Admin Mail
Function GenerateAdminMailBody()
Dim strReturn
strReturn = ""
strReturn = strReturn & "<style>" & vbNewLine
strReturn = strReturn & "table { font-family: Calibri; font-size: 11pt; }" & vbNewLine
strReturn = strReturn & "th { font: bold; background-color: light-blue; }" & vbNewLine
strReturn = strReturn & "th, td { border-bottom: 1px solid black; text-align: left; }" & vbNewLine
strReturn = strReturn & "tr:nth-child(even) { background-color: #f2f2f2; }" & vbNewLine
strReturn = strReturn & "tr:hover { background-color: #f5f5f5 }" & vbNewLine
strReturn = strReturn & "td.right { text-align: right; }" & vbNewLine
strReturn = strReturn & "div.dayspositive { }" & vbNewLine
strReturn = strReturn & "div.daysnegative { color: #FF0000; font: bold; }" & vbNewLine
strReturn = strReturn & "h1 { font: bold; font-size: 12pt; text-decoration: underline; }" & vbNewLine
strReturn = strReturn & "</style>" & vbNewLine
If Len(NZ(strAdminErrorUsers, "")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USERS GENERATED SCRIPT ERRORS:</u>" & vbNewLine
strReturn = strReturn & "<h1>USERS THAT GENERATED SCRIPT ERRORS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminErrorUsers & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th></tr>" & strAdminErrorUsers & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutPWexpires And Len(NZ(strAdminPWexpires,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING PASSWORDS WILL EXPIRE:</u>" & vbNewLine
strReturn = strReturn & "<h1>NOTIFIED USERS WITH EXPIRING PASSWORDS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminPWexpires & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminPWexpires & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutPWisExpired And Len(NZ(strAdminPWisExpired,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING PASSWORDS ARE EXPIRED ALREADY:</u>" & vbNewLine
strReturn = strReturn & "<h1>NOTIFIED USERS WITH EXPIRED PASSWORDS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminPWisExpired & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminPWisExpired & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutAccountWithoutEMail And Len(NZ(strAdminAccountWithoutEMail,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USER ACCOUNTS DON'T HAVE A VALID EMAIL ADDRESS:</u>" & vbNewLine
strReturn = strReturn & "<h1>USER ACCOUNTS WITH NO VALID EMAIL ADDRESS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminAccountWithoutEMail & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminAccountWithoutEMail & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutPWneverExpires And Len(NZ(strAdminPWneverExpires,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING PASSWORDS NEVER EXPIRE:</u>" & vbNewLine
strReturn = strReturn & "<h1>PASSWORD NEVER EXPIRES USERS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminPWneverExpires & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th></tr>" & strAdminPWneverExpires & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutUserCantChangePW And Len(NZ(strAdminUserCantChangePW,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USERS CAN'T CHANGE THEIR PASSWORDS:</u>" & vbNewLine
strReturn = strReturn & "<h1>THE FOLLOWING USERS CAN'T CHANGE THEIR PASSWORDS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminUserCantChangePW & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th></tr>" & strAdminUserCantChangePW & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutAccountDisabled And Len(NZ(strAdminAccountDisabled,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USER ACCOUNTS ARE DISABLED:</u>" & vbNewLine
strReturn = strReturn & "<h1>DISABLED USER ACCOUNTS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminAccountDisabled & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th></tr>" & strAdminAccountDisabled & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutExpiredUserAccount And Len(NZ(strAdminExpiredUserAccount,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USER ACCOUNTS ARE EXPIRED:</u>" & vbNewLine
strReturn = strReturn & "<h1>EXPIRED USER ACCOUNTS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminExpiredUserAccount & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminExpiredUserAccount & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutIgnoredUsersExcludedByGroup And Len(NZ(strAdminIgnoredUsersExcludedByGroup,"")) > 0 Then
strReturn = strReturn & "<h1>EXCLUDED USER ACCOUNTS (GROUP-FILTER):</h1>" & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminIgnoredUsersExcludedByGroup & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolInformAdminAboutStillGoodPasswords And Len(NZ(strAdminPWstillGood,"")) > 0 Then
'strReturn = strReturn & "<u>THE FOLLOWING USER ACCOUNTS HAVE VALID PASSWORDS:</u>" & vbNewLine
strReturn = strReturn & "<h1>THE FOLLOWING USER ACCOUNTS HAVE VALID PASSWORDS:</h1>" & vbNewLine
'strReturn = strReturn & strAdminPWstillGood & vbNewLine
strReturn = strReturn & "<table><tr><th>Firstname</th><th>LastName</th><th>Username</th><th>Expires in days</th></tr>" & strAdminPWstillGood & "</table><br><br>"
strReturn = strReturn & vbNewLine & vbNewLine
End If
If bolAttachDebugToAdminMail Then
'strReturn = strReturn & "<u>DEBUG OUTPUT:</u>" & vbNewLine
strReturn = strReturn & "<h1>DEBUG OUTPUT:</h1>" & vbNewLine
'strReturn = strReturn & strAdminDebug & vbNewLine
strReturn = strReturn & Replace(strAdminDebug, vbNewLine, "<br>") & vbNewLine
End If
GenerateAdminMailBody = "<div style=""font-family: calibri; font-size: 11pt;"">" & strReturn & "</div>"
End Function
'Sends out EMails, to the User (False, UserMailAddress, True or False, DaysLeft for Password, "") or the Admin (TRUE, "", True or False, 0, AdminTextBody)
Sub SendEmailNotification(AdminMail, UserMailAddress, IsExpired, DaysLeft, AdminTextBody)
Dim objMail
Set objMail = CreateObject("CDO.Message")
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSMTPServerPort
objMail.Configuration.Fields.Update
objMail.From = strFrom
If AdminMail Then 'is Admin Mail
objMail.Subject = strAdminMailSubject
objMail.To = strToAdmin
'objMail.TextBody = AdminTextBody
'objMail.HTMLBody = Replace(AdminTextBody, vbNewLine, "<br>")
objMail.HTMLBody = AdminTextBody
Else 'is User Mail
If Not bolAdminMailOnly Then 'only the Admin Mail will be send
If IsExpired Then
objMail.Subject = strUserMailSubjectExpired
Else
objMail.Subject = Replace(strUserMailSubjectWillExpire, "REPLACEWITHDAYS", DaysLeft)
End If
If bolRedirectMailToAdmin Then 'redirect Mails to Admin - add User Mail Address to Subject
objMail.To = strToAdmin
objMail.Subject = objMail.Subject & " - REDIRECTED TO ADMIN INSTEAD OF: " & UserMailAddress
Else
objMail.To = UserMailAddress
End If
objMail.CreateMHTMLBody strBodyURL
End If
End If
If Not bolTestDebugOutputToConsoleOnly Then
If Len(strAttachment) > 0 Then 'we do have an attachment to add?
objMail.AddAttachment strAttachment
End If
If bolAdminMailOnly Then 'only Admin Mail?
If AdminMail Then 'Then only if it is the Admin Mail
objMail.Send
End If
Else 'User Mail as well as Admin Mail
objMail.Send
End If
Else
ScriptDebug("=>DEBUG ONLY MODE - A EMAIL WOULD HAVE BEEN SEND TO: " & objMail.To & " - Subject: " & objMail.Subject)
End If
Set objMail = Nothing
End Sub
'Any Debug-Information will be proccessed here, easier to do it central and being able to change it to a LogFile or what ever...
Sub ScriptDebug(strDebugMessage)
If bolDebug Then
WScript.Echo strDebugMessage
End If
If bolAttachDebugToAdminMail Then
strAdminDebug = AddAdminInfoTo(strAdminDebug, strDebugMessage, False)
End If
End Sub