Profile Cleanup Script

In every organization users come and users go. Users are deleted, mailboxes are cleaned up, but most of the times the profile folder isn't cleaned up. After a couple of time there are a dozen of unused profiles located in the profile share. You can do this all by hand, but that's not the reason why you're working in IT. That's the reason I wrote this script.

This script automatically take ownership, reset the rights and deletes the folder. It only asks if you're sure to do all this actions.

NOTE: It has to be run directly on the server or used with a network mapped drive. UNC-path won't work.
This script is still in development. Updates will follow! The script works perfectly, but needs some finetuning for further automatization.

You can download the script here

 

'============================================================================
' VBScript Source File
' NAME: Rechten Home-Directory
' AUTHOR: Ruudvdh (WASTEIL)
' WEBSITE: http://wasteil.blogspot.com
' DATE  : 29-03-2007
' COMMENT: This script checkes in the profile folder for foldernames 
' which are not corresponding with a user in Active Directory. You will be
' asked te reset the rights on the folder who doesn't have a matching
' Username.
'
' !!!NEEDED PROGRAMS!!!
' XCACLS.EXE 
' This program is part of the Support Tools
' DOWNLOAD: 
' http://support.microsoft.com/kb/892777
'
' TAKEOWN.EXE --> 
' This program is part of the Windows 2000 Resource Kit tools
' Windows Server 2003 already has this file in the C:\WINDOWS\SYSTEM32 folder
' DOWNLOAD:
' http://www.petri.co.il/download_free_reskit_tools.htm
' Extract the takeown.exe in the C:\WINDOWS\SYSTEM32\ folder.
' 
'============================================================================

' DECLARING VARIABLES
Option Explicit
DIM answer, commando, colProcess
DIM counter1, counter2, counter3
DIM Folder, FSO
DIM intReturnValue, iReturn
DIM objCommand, objConnection, objFSO
DIM objRecordSet, objRootDSE, objShell
DIM objWMIService, objProcess, objTextFile
DIM processrun, result, rootFolder
DIM strFile, strFolder, strObjectName
DIM strComputer, strRootSearch, SubFolders

' INSTANTIATING AN OBJECT
SET objFSO         = CreateObject("Scripting.FileSystemObject")
SET objShell     = wscript.createObject("wscript.shell")
SET objRootDSE     = GetObject("LDAP://RootDSE")

' ASSIGNING VALUES TO CONSTANTS
CONST strObjectType    =    "user"
CONST ForAppending     =    8
CONST ForReading     =    1
CONST ForWriting     =    2

' ASSIGNING VALUES TO VARIABLES
DIM strFold(1)
strFold(1)        =     Lcase(Inputbox(Ucase("Enter path profile folder") &VbCr &VbCr _
                    &"Use the following style:" &VbCr _
                    &"D:\Profiles\","Profile Folder","D:\Profiles\"))
DIM process(2)
process(1)        =    "takeown.exe"
process(2)        =    "xcacls.exe"
DIM strFile2(2)
strFile2(1)     =    "C:\Windows\system32\takeown.exe"
strFile2(2)     =    "C:\Program Files\Support Tools\xcacls.exe"
strRootSearch     =    objRootDSE.Get("RootDomainNamingContext")
strComputer     =    "."

'================================SUBS=========================================
' SUB-procedure for checking folder name with user in Active Directory
SUB ADcheck()
    SET objConnection = CreateObject("ADODB.Connection")  
    objConnection.Open "Provider=ADsDSOObject;"    
    SET objCommand = CreateObject("ADODB.Command")  
    objCommand.ActiveConnection = objConnection 
    objCommand.CommandText = _
    "<LDAP://" & strRootSearch & ">;(&(objectCategory=" & strObjectType & ")" & _
    "(samAccountName=" & strObjectName & "));samAccountName,distinguishedName;subtree"

    SET objRecordSet    = objCommand.Execute
    SET objTextFile        = objFSO.OpenTextFile (strFolder & strFile, ForAppending, True)
    
    IF objRecordset.RecordCount = 0 THEN
        IF result = 2 THEN
            CALL ResetRights()
            END IF
        objTextFile.WriteLine(strObjectName)
        intReturnValue=0  
    ELSE
        objRecordSet.MoveFirst
        intReturnValue=1
    END IF
    objTextFile.Close
    objConnection.Close
END SUB

' SUB-procedure for checking running process
SUB processCHK()
    DO
        processrun = 0
        SET objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
        SET colProcess = objWMIService.ExecQuery ("Select * from Win32_Process")

        FOR EACH objProcess in colProcess
        IF objProcess.Name = process(counter2) THEN
            processrun = processrun + 1
            END IF
        NEXT

    IF processrun > 0 THEN
        wscript.sleep(5000)
    END IF

    SET objWMIService    = nothing
    SET colProcess        = nothing
    Loop Until processrun = 0
END SUB

' SUB-procedure for checking if al external programs are available on the system
SUB ProgramExist()
    result = 0
    FOR counter3 = 1 to 2
        IF objFSO.FileExists(strFile2(counter3)) THEN
            result = result + 1
            END IF
    NEXT
END SUB

' SUB-procedure for reading folder names
SUB strControl()
    SET rootFolder = objFSO.GetFolder(strFolder)
    SET SubFolders = rootFolder.SubFolders
    FOR Each Folder IN SubFolders
        strObjectName = replace(Lcase(Folder),strFolder,"")
        CALL ADcheck()
    NEXT
    SET rootFolder = NOTHING
    SET SubFolders = NOTHING
END SUB

SUB ResetRights()
    answer = MsgBox("Would you reset rights  and delete folder " &strObjectName,4,"Reset rights and Delete Folder")
    IF answer = 6 THEN
        commando     = "takeown /F " &Folder &" /R /A /D Y"
        iReturn     = objShell.Run(commando)
        counter2    = 1
        CALL processCHK()
        
        commando     = "xcacls " &Folder &" /g ""Domain Admins"":F /T /C /Y"
        iReturn     = objShell.Run(commando)
        counter2    = 2
        CALL processCHK()
        objFSO.DeleteFolder Folder,TRUE
        END IF
END SUB

'=============================END=OF=SUBS=====================================
'
'================================CODE=========================================
CALL ProgramExist()
FOR counter1 = 1 To 1
    strFolder = strFold(counter1)
    IF objFSO.FolderExists(strFolder) THEN
        strFile = Replace(Replace(strFold(counter1),Left(strFold(counter1),3),""),"\","") &"-folders.txt"
        SET objTextFile = objFSO.OpenTextFile (strFolder & strFile, ForWriting, True)
        objTextFile.Close
        CALL strControl()
    ELSE
        wscript.Echo "Folder: " &Ucase(strFolder) &" doesn't exist." &VbCr _
        &"Verify the location and try again."
        END IF
NEXT

wscript.Echo "FINISHED!"
SET objCommand = NOTHING
SET objConnection = NOTHING
SET objFSO = NOTHING
SET objRecordSet = NOTHING
SET objShell = NOTHING
SET rootFolder = NOTHING
SET SubFolders = NOTHING

'=============================END=OF=CODE=====================================
wscript.quit