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
Question
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?
--------------------------------
--------------------------------
Edited by kuroiAdicionar tag CODE
Link to comment
Share on other sites
0 answers to this question
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.