Transfer Drive Clean Up

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Transfer Drive Clean Up

Logged in as: Guest

arrSession:exec spGetSession 2,16,54748

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Transfer Drive Clean Up
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Transfer Drive Clean Up - 12/28/2007 10:44:17 AM

Meg

Posts: 125
Score: 2
Joined: 7/13/2006
From: Australia
Status: offline

I wrote this script in WMI for fun, I thought it would be easier than what it was, some places I needed to do a little fiddling, I am sure some of the gurus here could make it much simpler, but as they say practice makes perfect.

'Script by MJP 2007
'Transfer Drive Cleanup Script

'WMI recersively determines age of all files and subfolders.
'Deletes files if older than certain age.
'Deletes subfolders if older than certain age and empty.
'Creates a log file.
'Tested on WinXP Pro and Windows 2003 Server.
'Users must only have access to transfer drive via drive letter so that they can not MOVE items there as those items will have an old creation date.

Dim DeletedDir, strLine 
Dim FAC
Dim FA : FA=0
dim FolderArray(2048)

strComputer = "."                   'Remote computer you want to run script on use "." for local.
strFolder = "C:\Scripts"            'Folder share of files and folders you want to examine.
strLog = "C:\dlog.txt"              'Log file created for your records. Created locally on machine script is run from. 
DelAge = 7                          'Enter number in days - if file is DelAge then it will be deleted.

WriteLog ""
WriteLog "Transfer Drive Script Started "&now
ListFiles strFolder                 'Sub- List all files in the folder
ListFolders strFolder               'Sub- List all subfolders in the folder

'Delete old empty folders starting from the bottom of the folder structure 
if FolderArray(0) <>"" then
  do 
     SubFCheck FolderArray(FA-1)  'Sub- Delete old empty folders
     FA=FA-1
  loop until FA=0
end if

WriteLog "Transfer Drive Cleanup Completed "&now
wscript.echo "finished"
wscript.quit

'--------------------------------------------------------------

sub ListFiles(strFolder)
'List all files in the folder
if DeletedDir<>strFolder then
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFileList = objWMIService.ExecQuery _
    ("ASSOCIATORS OF {Win32_Directory.Name='"&strfolder&"'} Where " _
        & "ResultClass = CIM_DataFile")

For Each objFile In colFileList

MyFileP= chr(34)&objFile.Name&chr(34)
    MyFileP=replace(MyFileP,"\","\\") 
    filep myfilep    'Sub- Read the creation date of each file
Next
end if
end sub

'--------------------------------------------------------------

sub ListFolders(strFolder)
'List all the subfolders in the folder
on error resume next
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSubfolders = objWMIService.ExecQuery _
   ("Associators of {Win32_Directory.Name='"&strfolder&"'} " _
       & "Where AssocClass = Win32_Subdirectory " _
           & "ResultRole = PartComponent")
For Each objFolder in colSubfolders
   
   ListFiles objFolder.Name              'Sub- List all files in the folder
   MyFolderP = chr(34)&objFolder.Name&chr(34)
   MyFolderP = replace(MyFolderP,"\","\\")
   folderp myfolderp                     'Sub- Read the creation date of this folder
   ListFolders objFolder.Name            'Sub- List all the subfolders in the folder - Yes I am calling the same sub from within
Next

end sub

'--------------------------------------------------------------

sub FolderP(xxx)
'Read Folder Creation date
 
   Set objWMIService = GetObject("winmgmts:" _
       & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colFolders = objWMIService. _
       ExecQuery("Select * from Win32_Directory where name = "&xxx)
   
   For Each objFolder in colFolders
       DateC=objFolder.CreationDate 
       DateCheck DateC, xxx          'Sub- Check if the creation date is old enough to delete
   Next

end sub

'--------------------------------------------------------------

Sub FileP(xxx)
'Read File Creation Date
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
   ("Select * from CIM_Datafile Where name = "&xxx)
For Each objFile in colFiles
   DateC=objFile.CreationDate 
   DateCheck DateC, xxx          'Sub- Check if the creation date is old enough to delete 
Next
end sub

'--------------------------------------------------------------

sub DateCheck(DateC,Name)

'Cleanup Name
Name=replace(Name, "\\", "\")
L=len(name)
Name=right(Name,L-1):Name=left(Name,L-2)
'Cleanup Date
Datec=left(datec,8)
y=left(datec,4)
d=left(datec,6):d=right(d,2)
m=right(datec,2)
datec=d&"/"&m&"/"&y
'Check Date 
FileAge= (DateDiff("d",Datec,now))
WriteLog "File "&Name&" is "& FileAge &" days old"
If FileAge=>DelAge then
  FileDelete Name        'Sub- check if it is a file and delete it 
  DirEmptyCheck Name     'Sub- check if it is a folder and it is empty
end if
end sub

'--------------------------------------------------------------

Sub FileDelete(OldFile)
FileName=OldFile
' Delete old file 
oldfile=chr(34)&oldfile&chr(34)
oldfile=replace(oldfile, "\", "\\")
on error resume next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("SELECT * FROM CIM_DataFile WHERE name = "&oldfile)
For Each objFile in colFiles
objFile.Delete
if err.number<>0 then exit sub
WriteLog "File "&FileName& " DELETED"
Next
end sub

'--------------------------------------------------------------

Sub DirEmptyCheck(strFolder)
'Count the files in the folder
x=0
strFolder=replace(strFolder, "\\", "\")
strFolder = replace(strFolder, chr(34), "")
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFileList = objWMIService.ExecQuery _
   ("ASSOCIATORS OF {Win32_Directory.Name='"&strFolder&"'} Where " _
       & "ResultClass = CIM_DataFile")
on error resume next
For Each objFile In colFileList
  x=x+1
Next
if err.number<>0 then exit sub 
On error goto 0
If x=0 then 
  AddDel strFolder      'Sub- Add as marked for deletion
end if
End Sub

'--------------------------------------------------------------

Sub AddDel(strFolder)
FolderArray(FA)=strFolder
FA=FA+1
End Sub

'--------------------------------------------------------------

sub SubFCheck(strFolder)
'Count the subfolders in the folder
y=0
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSubfolders = objWMIService.ExecQuery _
   ("Associators of {Win32_Directory.Name='"&strFolder&"'} " _
       & "Where AssocClass = Win32_Subdirectory " _
           & "ResultRole = PartComponent")
For Each objFolder in colSubfolders
  y=y+1
Next
if y=0 then
  DirDelete strFolder       'Sub- Delete Folder as it is empty and old
end if
end sub

'--------------------------------------------------------------

Sub DirDelete(strFolder)
'This sub will delete Folders
strFolder = replace(strFolder, "\", "\\")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFolders = objWMIService.ExecQuery _
   ("Select * from Win32_Directory where Name = '" & strFolder & "'")
For Each objFolder in colFolders
   errResults = objFolder.Delete
   DeletedDir=replace (strFolder, "\\" , "\")
   WriteLog "Dir- "& DeletedDir & " DELETED"
   
Next
End sub

'--------------------------------------------------------------

Sub WriteLog(strLine)
Const ForAppending = 8
'Create log file and set header line if it is new
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strLog) Then
  '
Else
  Set objFile = objFSO.CreateTextFile(strLog)'file created
  strLine= "Transfer Drive Cleanup Script" 
End If
set objFile = nothing
'Open log file, write line and close log file
Set objTextFile = objFSO.OpenTextFile (strLog, ForAppending, True)
objTextFile.WriteLine(strLine) 'append result to txt log file
objTextFile.Close

End Sub

'--------------------------------------------------------------