Clean Up User Profiles Using ADSI

SDIM UserObj
DIM Object
DIM GroupObj
Dim Flags
DIm strProfile
DIM strUser
DIM result
Dim strErrMsg

' This constant determines whether the script should just log the changes it intends to make without actually doing them
' This allows an administrator to review the changes before setting the flag to FALSE which causes the changes to actually happen
CONST LogOnly = True

' Path to group containing accounts to check
Set GroupObj = GetObject("WinNT://MY_PC/Users")
On error resume next
       
For each Object in GroupObj.Members
    strErrMsg = "No Errors"
    ' Find all Computer Objects
    If Object.Class = "User" then
        Set UserObj = GetObject(Object.ADsPath)
        strProfile = UserObj.get("Profile")
        strUser = Object.Name
        if instr(strProfile,strUser)> 0 then
    Set fso = CreateObject("Scripting.FileSystemObject")
            If (fso.FolderExists(strProfile)) Then
                ' Only acutally delete profiles if LogOnly is set to FALSE
            If LogOnly = False Then
                result = DeleteProfile(strUser,strProfile)
            End if
        Else
            strErrMsg = "Path Not Found"
        End if   
        ' Trap any errors
    if Err Then
                Select Case Err.Number
            Case 70     strErrMsg = "Access Denied"
            Case 75 strErrMsg = "Path/File access error"
        End Select
            end if    
            result = Logit(strUser,strProfile,strErrMsg)        
end if
end if
Next


Set fso = Nothing


' Delete the profile for the user
Function DeleteProfile(User,Profile)

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    fso.DeleteFolder Profile,True

    Set fso = Nothing

end function


' Log results
Function Logit(User,Profile,Errors)
    ' Path to Log File
    CONST strLogFile = "C:\DelProfile.txt"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set strTextStream = objFS.OpenTextFile(strLogFile, 8, true)
   
    strTextStream.WriteLine("Account:" & vbTab & User & vbTab & "Profile Path:" & vbTab & strProfile & vbTab & "Errors:" & vbtab & Errors & vbTab & "Date:" & vbTab & Date & vbTab & "Time:" & vbTab & Time)
    strTextStream.Close

    Set objFS = Nothing
    Set strTextStream = Nothing

end Function