Adriano_FR

Estou com um script para deletar perfis antigos com mais de 90 dias, porém gostaria de colocar execeção para as pastas administrator e AllUsers. Como faço? alguém pode me ajudar? -------------------------------- Const ForReading = 1 Const ForWriting = 2 intAgeToDelete = 90 ' The age (in days) to delete files if equal or older. ForAppending = 8 intDeletedCount = 0 LogFilename = "C:\Documents and Settings\te27814\Desktop\Limpeza\ReportCleaner.log" serverLogName = "C:\Documents and Settings\te27814\Desktop\Limpeza\logFoldersWithServerName.txt" Set WshNetwork = WScript.CreateObject("WScript.Network") 'declaration of a network object for storing computer name Dim NowFolder 'Open a log file Set fso = CreateObject("Scripting.FileSystemObject") Set OutputFile = FSO.OpenTextFile(LogFilename, ForAppending, True) 'Open server file Set objInputFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objInputFSO.OpenTextFile(serverLogName, ForReading) Do Until objTextFile.AtEndOfStream strNextServerLine = objTextFile.ReadLine If strNextServerLine <> "" Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strNextServerLine) Set colSubfolders = objFolder.Subfolders for Each objsubFolder in colSubfolders NowFolder = strNextServerLine & "\" & objsubFolder.Name 'WScript.Echo NowFolder & vbTab & int(objsubFolder.Size/1048576) Set checkfolder = fso.GetFolder(NowFolder) 'wscript.echo checkfolder.Path 'wscript.echo checkfolder.DateLastModified DeleteFolders checkfolder Next End If Loop '---------------------------- Sub DeleteFolders(strFolder) DaysOld = Round(now() - strFolder.DateLastModified) If DaysOld >= intAgeToDelete Then WScript.Echo vbCrlf & "Deleted" & "|" & strFolder & "|" & strFolder.DateLastModified & "|" & strFolder.DateCreated & "|" & DaysOld & "|" & now() OutputFile.write vbCrlf & "Deleted" & "|" & strFolder & "|" & strFolder.DateLastModified & "|" & strFolder.DateCreated & "|" & DaysOld & "|" & now() strFolder.Delete True End If End Sub '---------------------------- On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") i = 0 ' *** Ask for full path ' *** Run the Script Dim arrFolders() FindSubfolders FSO.GetFolder(strAnswer) Sub FindSubfolders(Folder) For Each Subfolder in Folder.SubFolders If SubFolder.Size = 0 Then ' *** Expand array as necesary and add paths to delete Redim Preserve arrFolders(i) arrFolders(i) = SubFolder.Path i = i + 1 ' Show Empty Folder? ' Wscript.Echo "This folder is empty: " & SubFolder.Path End If Wscript.StdOut.Write(".") FindSubfolders Subfolder Next End Sub ' *** Last chance before deleting folders x=i If x = 0 then MsgBox "No EMPTY folders found" Else intAnswer = Msgbox("Do you REALLY want to delete " & x & " EMPTY folders?", _ vbYesNo, "Delete ONLY Empty Folders") If intAnswer = vbYes Then ' Run the Script For i = 0 to x Wscript.Echo "Deleting Empty Folder: " & arrFolders(i) FSO.DeleteFolder(arrFolders(i)) Next Else Wscript.quit End If End If ' *** Clean memory and quit Set FSO = Nothing Set i = Nothing Set x = Nothing Set intAnswer = Nothing Set arrFolders() = Nothing Wscript.Quit --------------------------------