DESCRIPTION
Steps through all the users in the AD scope and checks to see if the account has expired. If so - has it been expired for more than 30 days and, if so, get the path and share to the home directory and remove the account's access. Then, delete the user object
NOTES
If the home directory path is blank then the user is deleted. If any part of the deletion process for the share fails then the physical path to the users home dir is stored in the edvsaHomeDirectory virtual attribute so that subsequent runs of the script can find and delete the home directory and then the user object.
Note This code may use functions from the Active Roles Script Policy Best Practices. Please, follow the link to obtain instructions and code for those functions.
SCRIPT
'*********************************************************************************
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT ONE IDENTITY PROFESSIONAL SERVICES.
'*********************************************************************************
EventLog.ReportEvent 4, "DeleteExpiredUsers started processing at " & Time() & " On " & Date()
Set objConnection = CreateObject("ADODB.Connection")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
'
' Note: You need to set the correct path to root of the OU where this script runs.
'
objCommand.CommandText = ";" &
"(&(objectCategory=person)(objectClass=user));" & "ADsPath;subtree"
objCommand.Properties("Page Size") = 10000
Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
strADsPath = objRecordset.Fields("ADsPath")
Set oUser = GetObject(strADsPath)
Call deleteExpiredUser (oUser.distinguishedname)
objrecordset.MoveNext
Wend
objConnection.Close
EventLog.ReportEvent 4, "DeleteExpiredUsers finished processing at " & Time() & " On " & Date()
'**********************************************************************************
Sub deleteExpireduser(userDN)
'**********************************************************************************
'EDS_EVENTLOG_SUCCESS 0 Success Event
'EDS_EVENTLOG_ERROR_TYPE 1 Error Event
'EDS_EVENTLOG_WARNING_TYPE 2 Warning Event
'EDS_EVENTLOG_INFORMATION_TYPE 4 Information Event
'EDS_EVENTLOG_AUDIT_SUCCESS 8 Success Audit Event
'EDS_EVENTLOG_AUDIT_FAILURE 16 Failure Audit Event
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
'
' Note: You need to set the path to the log location below
'
Set deleteLog = fso.openTextFile("C:\Path To Some Folder\deletelog.txt",8, true)
'See if the user has an expiry date set
Set objUser = GetObject("EDMS://" & userDN)
dtmAccountExpiration = objUser.AccountExpirationDate
If Err.Number = -2147467259 Or dtmAccountExpiration = "01/01/1970" Or dtmAccountExpiration =
"01/01/1601 01:00:00" Then
On Error GoTo 0
Else
'Get the date difference from now
diffDate = DateDiff("d", Now, objUser.AccountExpirationDate)
If CInt(diffDate) <= -30 Then
'start the deletion process because the expiry date is more than 30 days in the past
homeDir = objUser.homeDirectory
'Check if the home directory attribute is not blank
If homeDir = "" Then
EventLog.ReportEvent 1, objUser.cn & "'s home directory path is blank. Processing on this
user is stopped"
'Delete the user
Call deleteUser(userDn, objUser.cn)
Exit Sub
End If
serverPath = Split(Right(homeDir,Len(homeDir)-2), "\")
'Get the physical path to the share so that the folder can be deleted.
If Not getSharePath(serverPath(0), serverPath(1), folderPath) Then
'get the edvsaHomeDrivePath attribute
objUser.GetInfoEx Array("edvsaHomeDrivePath"),0
On Error Resume Next
physHomePath = user.Get("edvsaHomeDrivePath")
On Error GoTo 0
If physHomePath = "" Then
EventLog.ReportEvent 1, "Physical Home Folder path not confirmed for " &
objUser.userPrincipalName & " - Processing is stopped on this user"
Exit Sub
Else
'Try again to delete the user home directory
If deleteHomeFolder(folderPath) Then
Call deleteUser(userDn, objUser.cn)
EventLog.ReportEvent 0, objUser.userPrincipalName & "'s home folder was deleted
from " & folderPath
Else
EventLog.ReportEvent 0, "There was a problem removing the home directory for " &
objUser.userPrincipalName & " Error Code : " & Err.Number & " " & Err.Description
Exit Sub
End If
End If
Else
' Write the physical share path to the VA
objUser.GetInfoEx Array("edvsaHomeDrivePath"),0
objUser.Put "edvsaHomeDrivePath", folderPath
objUser.SetInfo
'Now Remove the share
If removeShare(serverPath(0), serverPath(1)) Then
EventLog.ReportEvent 0, objUser.userPrincipalName & "'s home folder share was
removed from " & objUser.homeDirectory
'delete the home directory
If deleteHomeFolder(folderPath) Then
Call deleteUser(userDn, objUser.cn)
EventLog.ReportEvent 0, objUser.userPrincipalName & "'s home folder was deleted
from " & folderPath
Else
EventLog.ReportEvent 1, "There was a problem removing the home directory
for " & objUser.userPrincipalName & " Error Code : " & Err.Number & " " & Err.Description
Exit Sub
End If
Else
EventLog.ReportEvent 1, "There was a problem removing " &
objUser.userPrincipalName & "'s home directory share - Error Code : " & Err.Number & " " &
Err.Description
Exit Sub
End If
End If
End If
End If
End Sub
'*****************************************************************
Function getSharePath (serverName, shareName, fPath)
'*****************************************************************
'Gets the physical location of the share and returns the path & physicalPath
'so that the folder can be deleted
On Error Resume Next
strComputer = serverName
'Try to connect to the share - if not set false and quit otherwise
'WMI will fail and the script will Error
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName("\\" & serverName & "\" & shareName))
If err.Number <> 0 Then
GetSharePath = False
Set fso = Nothing
Exit Function
End If
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share where name = '" & shareName & "'")
For Each objShare In colShares
physicalPath = lCase(objShare.Path)
Next
If physicalPath = "" Then
getSharePath = False
Else
'Get the path after the share
searchCrit = "AllUsersRootShareFolder" 'all users will be below this share name
strStart = InStr(physicalPath, searchCrit)
pathBelowShare = Right(physicalPath,Len(physicalPath) - (strStart + Len(searchCrit)))
'Turn it into a UNC
getSharePath = True
fPath = "\\" & serverName & "\AllUsersRootShareFolder\" & pathBelowShare
End If
Set fso = Nothing
End Function
'*****************************************************************
Function removeShare(shServer, shName)
'*****************************************************************
'Removes the share from the home folder server.
On Error Resume Next
'Try to connect to the share - if not set false and quit otherwise
'WMI will fail and the script will error
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName("\\" & shServer & "\" & shName))
If err.Number <> 0 Then
removeShare = False
Exit Function
End If
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & shServer & "\root\cimv2")
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share Where Name = '" & shName & "'")
For Each objShare In colShares
objShare.Delete
If err.Number = 0 Then
removeShare = True
Else
removeShare = False
End If
Next
End Function
'**********************************************************************
Sub deleteUser(distName, usrCn)
'**********************************************************************
'Deletes the user object. Returns the error message so
'that an event can be written.
On Error Resume Next
'Get the start of the OU string from the dn
ouStart = InStr(LCase(distName),"ou") -1
'Get the path to the OU
ouPath = Right(distName, Len(distName) - ouStart)
Set objOU = GetObject("EDMS://" & ouPath)
objOU.Delete "user", "cn=" & usrCn
If Err.Number = 0 Then
deleteUser = True
EventLog.ReportEvent 0, "User " & usrCn & " was deleted successfully"
Else
deleteUser = False
EventLog.ReportEvent 1, "There was a problem deleting " & usrCn & " Error Code : " & Err.Number
& " " & Err.description
End If
End Sub
'********************************************************************
Function deleteHomeFolder(fPath)
'********************************************************************
'Removes the physical folders from the server
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFolder = fso.GetFolder(fPath)
myFolder.Delete force
If Err.Number = 0 Then
deleteHomeFolder = True
Else
deleteHomeFolder = False
End If
End Function
'***** END OF CODE ***************************************************************