Jump to content
Fórum Script Brasil
  • 0

Dúvidas VBscript


Adriano_FR

Question

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

--------------------------------

Edited by kuroi
Adicionar tag CODE
Link to comment
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.2k
    • Total Posts
      652k
×
×
  • Create New...