Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Scheduled Task for deleting files?
- Thread starter a96pirate
- Start date
This is the site,
I'm not sure if this is what your looking at, but below is the source, you could customize it for yourself.
I found this on-line:
Option Explicit
On Error Resume Next
' Deletes old files based on age, access date, extension.
' Written by Eric Phelps
'
'Force "cscript"
Main
Wscript.Quit 0
Sub Main()
Dim fil 'As Scripting.File
Dim fils 'As Scripting.Files
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim fs 'As Scripting.FileSystemObject
Dim strDirectories() 'As String
Dim lngCounter 'As Long
Dim dblMaxCreateAge 'As Double
Dim dblMaxAccessedAge 'As Double
Dim strFileTypes 'As String
Const READONLY = 1
Const HIDDEN = 2
Const SYSTEM = 4
If MsgBox ("This program will delete files in and below a directory you designate based on file age, extension, and last access. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit
Set fs = CreateObject("Scripting.FileSystemObject"
If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & FileNameInThisDir("DeleteOld.log" & ". Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, "Delete Old Files" = vbCancel Then Wscript.Quit
Else
If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen and will not be logged. Run this program under WSCRIPT if you want a log file. Continue?", vbOkCancel, "Delete Old Files" = vbCancel Then Wscript.Quit
End If
Redim strDirectories(0)
strDirectories(0) = fs.GetAbsolutePathName(InputBox("Enter path to start deleting at:", "Delete Old Files", FileNameInThisDir(""))
If strDirectories(0) = "" Then Wscript.Quit
strFileTypes = InputBox("Enter 3-character extensions for file types you want deleted", "Delete Old Files", "txt, doc, xls, ppt, gif, jpg"
If strFileTypes = "" Then Wscript.Quit
dblMaxCreateAge = CDbl(InputBox("Enter the minimum time since file creation (in days) of files to delete", "Delete Old Files", "180")
If dblMaxCreateAge < 1 Then Wscript.Quit
dblMaxAccessedAge = CDbl(InputBox("Enter the minimum time since last file access (in days) of files to delete", "Delete Old Files", "60")
If dblMaxAccessedAge < 1 Then Wscript.Quit
If MsgBox("This is your last question. File deletion starts if you click yes. Okay to delete all " & strFileTypes & " in and below the " & strDirectories(0) & " directory created over " & dblMaxCreateAge & " days ago and not accessed for the past " & dblMaxAccessedAge & " days?", vbYesNo, "Delete Old Files" = vbNo Then Wscript.Quit
lngCounter = 0
Status "*************************************"
Status "*************************************"
Status "Program: " & Wscript.ScriptFullName
Status "Program started: " & Now
Status "Deleting " & strFileTypes & " in and below " & strDirectories(0) & " older than " & dblMaxCreateAge & " days and not accessed in over " & dblMaxAccessedAge & " days"
Do Until lngCounter > Ubound(strDirectories,1)
'Next folder to process
Set fol = fs.GetFolder(strDirectories(lngCounter))
'Get each file in turn
Set fils = fol.Files
If Err.Number <> 0 Then Exit Sub
For Each fil In fils
If Instr(strFileTypes, Lcase(Right(fil.ShortName,3))) <> 0 Then
If (CDbl(Now) - CDbl(fil.DateCreated)) > dblMaxCreateAge Then
If (CDbl(Now) - CDbl(fil.DateLastAccessed)) > dblMaxAccessedAge Then
If ((fil.Attributes And READONLY) = 0) Then
If ((fil.Attributes And SYSTEM) = 0) Then
If ((fil.Attributes And HIDDEN) = 0) Then
If Lcase(fil.Path) <> Lcase(Wscript.ScriptFullName) Then
Status fil.Path
Status " DELETED"
Status " Date Created " & fil.DateCreated
Status " Date Modified " & fil.DateLastModified
Status " Date Accessed " & fil.DateLastAccessed
fil.Delete
End If
End If
End If
End If
End If
End If
End If
Next
'Check for any sub folders and add them to the folder array
Set fols = fol.SubFolders
For each fol in fols
If Lcase(fol.Name) <> "recycled" Then
Redim Preserve strDirectories(Ubound(strDirectories,1) + 1)
strDirectories(Ubound(strDirectories,1)) = fol.Path
End If
Next
lngCounter = lngCounter + 1
Loop
Status "Program finished: " & Now
Status "*************************************"
Status "*************************************"
If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & FileNameInThisDir("DeleteOld.log", vbOkOnly, "Delete Old Files"
End Sub
Function FileNameInThisDir(strFileName) 'As String
'Returns the complete path and file name to a file in
'the script directory. For example, "trans.log" might
'return "C:\Program Files\Scripts\Database\trans.log"
'if the script was in the "C:\Program Files\Scripts\Database"
'directory.
Dim fs 'As Scripting.FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject"
FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
''''''''''Clean up
Set fs = Nothing
End Function
Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it writes
'to a log named "DeleteOld.log" in the same directory as
'the script.
Dim ts 'As Scripting.TextStream
Dim fs 'As Scripting.FileSystemObject
Const ForAppending = 8 'Scripting.IOMode
If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
Wscript.Echo strMessage
Else
Set fs = CreateObject("Scripting.FileSystemObject"
Set ts = fs.OpenTextFile(FileNameInThisDir("DeleteOld.log", ForAppending, True)
ts.WriteLine strMessage
ts.Close
''''''''''Clean up
Set ts = Nothing
Set fs = Nothing
End If
End Sub
Sub Force(sScriptEng)
'Forces this script to be run under the desired scripting host
'Valid sScriptEng arguments are "wscript" or "cscript"
'If you don't supply a valid name, Force will switch hosts...
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
'Running under WSCRIPT
If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
'Need to switch to CSCRIPT
CreateObject("Wscript.Shell".Run "cscript.exe " & Wscript.ScriptFullName
Wscript.Quit
End If
Else
'Running under CSCRIPT
If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
'Need to switch to WSCRIPT
CreateObject("Wscript.Shell".Run "wscript.exe " & Wscript.ScriptFullName
Wscript.Quit
End If
End If
End Sub
I'm not sure if this is what your looking at, but below is the source, you could customize it for yourself.
I found this on-line:
Option Explicit
On Error Resume Next
' Deletes old files based on age, access date, extension.
' Written by Eric Phelps
'
'Force "cscript"
Main
Wscript.Quit 0
Sub Main()
Dim fil 'As Scripting.File
Dim fils 'As Scripting.Files
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim fs 'As Scripting.FileSystemObject
Dim strDirectories() 'As String
Dim lngCounter 'As Long
Dim dblMaxCreateAge 'As Double
Dim dblMaxAccessedAge 'As Double
Dim strFileTypes 'As String
Const READONLY = 1
Const HIDDEN = 2
Const SYSTEM = 4
If MsgBox ("This program will delete files in and below a directory you designate based on file age, extension, and last access. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit
Set fs = CreateObject("Scripting.FileSystemObject"
If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & FileNameInThisDir("DeleteOld.log"
& ". Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, "Delete Old Files" = vbCancel Then Wscript.QuitElse
If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen and will not be logged. Run this program under WSCRIPT if you want a log file. Continue?", vbOkCancel, "Delete Old Files"
= vbCancel Then Wscript.QuitEnd If
Redim strDirectories(0)
strDirectories(0) = fs.GetAbsolutePathName(InputBox("Enter path to start deleting at:", "Delete Old Files", FileNameInThisDir(""
))If strDirectories(0) = "" Then Wscript.Quit
strFileTypes = InputBox("Enter 3-character extensions for file types you want deleted", "Delete Old Files", "txt, doc, xls, ppt, gif, jpg"
If strFileTypes = "" Then Wscript.Quit
dblMaxCreateAge = CDbl(InputBox("Enter the minimum time since file creation (in days) of files to delete", "Delete Old Files", "180"
)If dblMaxCreateAge < 1 Then Wscript.Quit
dblMaxAccessedAge = CDbl(InputBox("Enter the minimum time since last file access (in days) of files to delete", "Delete Old Files", "60"
)If dblMaxAccessedAge < 1 Then Wscript.Quit
If MsgBox("This is your last question. File deletion starts if you click yes. Okay to delete all " & strFileTypes & " in and below the " & strDirectories(0) & " directory created over " & dblMaxCreateAge & " days ago and not accessed for the past " & dblMaxAccessedAge & " days?", vbYesNo, "Delete Old Files"
= vbNo Then Wscript.QuitlngCounter = 0
Status "*************************************"
Status "*************************************"
Status "Program: " & Wscript.ScriptFullName
Status "Program started: " & Now
Status "Deleting " & strFileTypes & " in and below " & strDirectories(0) & " older than " & dblMaxCreateAge & " days and not accessed in over " & dblMaxAccessedAge & " days"
Do Until lngCounter > Ubound(strDirectories,1)
'Next folder to process
Set fol = fs.GetFolder(strDirectories(lngCounter))
'Get each file in turn
Set fils = fol.Files
If Err.Number <> 0 Then Exit Sub
For Each fil In fils
If Instr(strFileTypes, Lcase(Right(fil.ShortName,3))) <> 0 Then
If (CDbl(Now) - CDbl(fil.DateCreated)) > dblMaxCreateAge Then
If (CDbl(Now) - CDbl(fil.DateLastAccessed)) > dblMaxAccessedAge Then
If ((fil.Attributes And READONLY) = 0) Then
If ((fil.Attributes And SYSTEM) = 0) Then
If ((fil.Attributes And HIDDEN) = 0) Then
If Lcase(fil.Path) <> Lcase(Wscript.ScriptFullName) Then
Status fil.Path
Status " DELETED"
Status " Date Created " & fil.DateCreated
Status " Date Modified " & fil.DateLastModified
Status " Date Accessed " & fil.DateLastAccessed
fil.Delete
End If
End If
End If
End If
End If
End If
End If
Next
'Check for any sub folders and add them to the folder array
Set fols = fol.SubFolders
For each fol in fols
If Lcase(fol.Name) <> "recycled" Then
Redim Preserve strDirectories(Ubound(strDirectories,1) + 1)
strDirectories(Ubound(strDirectories,1)) = fol.Path
End If
Next
lngCounter = lngCounter + 1
Loop
Status "Program finished: " & Now
Status "*************************************"
Status "*************************************"
If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & FileNameInThisDir("DeleteOld.log"
, vbOkOnly, "Delete Old Files"End Sub
Function FileNameInThisDir(strFileName) 'As String
'Returns the complete path and file name to a file in
'the script directory. For example, "trans.log" might
'return "C:\Program Files\Scripts\Database\trans.log"
'if the script was in the "C:\Program Files\Scripts\Database"
'directory.
Dim fs 'As Scripting.FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject"
FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
''''''''''Clean up
Set fs = Nothing
End Function
Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it writes
'to a log named "DeleteOld.log" in the same directory as
'the script.
Dim ts 'As Scripting.TextStream
Dim fs 'As Scripting.FileSystemObject
Const ForAppending = 8 'Scripting.IOMode
If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
Wscript.Echo strMessage
Else
Set fs = CreateObject("Scripting.FileSystemObject"
Set ts = fs.OpenTextFile(FileNameInThisDir("DeleteOld.log"
, ForAppending, True)ts.WriteLine strMessage
ts.Close
''''''''''Clean up
Set ts = Nothing
Set fs = Nothing
End If
End Sub
Sub Force(sScriptEng)
'Forces this script to be run under the desired scripting host
'Valid sScriptEng arguments are "wscript" or "cscript"
'If you don't supply a valid name, Force will switch hosts...
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
'Running under WSCRIPT
If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
'Need to switch to CSCRIPT
CreateObject("Wscript.Shell"
.Run "cscript.exe " & Wscript.ScriptFullNameWscript.Quit
End If
Else
'Running under CSCRIPT
If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then
'Need to switch to WSCRIPT
CreateObject("Wscript.Shell"
.Run "wscript.exe " & Wscript.ScriptFullNameWscript.Quit
End If
End If
End Sub
- Status
Similar threads
- Locked
- Question
- Locked
- Question