How to clean directories in Windows using Visual Basic Script

May 15, 2006 at 1:12 pm

1 Star2 Stars3 Stars4 Stars5 Stars (1 votes, average: 4 out of 5)
Loading ... Loading ...

Copy the text below into notepad and save as cleanfiles.vbs
You can then run the job with parameters, or as a schedule in windows Task Manager. It will remove files according to the specification fed on the command line. For instance use
wscript cleanfiles.vbs c:\temp 0
to clear out the temp directory on the c: drive. Change the number to determine how old files must be before being deleted. See full post for more details

‘ Usage: wscript cleanfiles.vbs [-r]|[-d]

Option Explicit
‘On Error Resume Next
Dim fso, PathToClean, numberOfDays, folder, rootFolder, objFolder, objSubfolders
Dim objFiles, folderToClean, folderToCheck,objArgs, fileFilter, numArgs, recursive, deleteDirs

Set objArgs = Wscript.Arguments

If objArgs.count < 3 Then
'Wscript.echo "Usage: wscript cleanfiles.vbs [-r]|[-d]

"
Wscript.Quit 1
End IfnumArgs = 0

If objArgs.count > (3 + numArgs) And objArgs(numArgs) = “-r” Then
recursive = 1
numArgs = numArgs + 1
End If

If objArgs.count > (3 + numArgs) And objArgs(numArgs) = “-d” Then
deleteDirs = 1
recursive = 1
numArgs = numArgs + 1
End If

PathToClean = objArgs(numArgs)
fileFilter = objArgs(numArgs+1)
numberOfDays = Cint(objArgs(numArgs+2))

Set fso = CreateObject(”Scripting.FileSystemObject”)

‘Start at the folder specified and walk down the directory tree
Set rootFolder = fso.GetFolder(PathToClean)
If Err.Number > 0 Then
‘Wscript.echo “Invalid directory path. Please correct the path and run the script again.”
Wscript.Quit 2
End If

If recursive > 0 Then
GetSubfolders(rootFolder)
End If
CleanupFiles(rootFolder)

‘Clean up
Set fso = Nothing

Wscript.Quit

Sub GetSubfolders(folder)
Dim oSubfolder
Set objFolder = fso.GetFolder(folder)
Set objSubfolders = objFolder.Subfolders
Set objFiles = objFolder.Files

For Each oSubfolder in objSubfolders
‘Recursively go down the directory tree
GetSubfolders(oSubfolder.Path)

‘Cleanup any files that meet the criteria
CleanupFiles(oSubfolder.Path)

‘Delete the folder if its empty
If deleteDirs > 0 Then
CleanupFolder(oSubfolder.Path)
End If
Next
End Sub

Sub CleanupFiles(folderToClean)
dim objFile
set objFolder = fso.GetFolder(folderToClean)
set objFiles = objFolder.Files
For Each objFile in objFiles
If (DateDiff(”d”, objFile.DateLastModified, Now) > numberOfDays) or (numberOfDays = 0) Then
If CompareFileName(objFile.Name,fileFilter) Then
objFile.Delete
End If
End If
Next
Set objFolder = Nothing
Set objFiles = Nothing
End Sub

Sub CleanupFolder(folderToCheck)
Set objFolder = fso.GetFolder(folderToCheck)
Set objSubfolders = objFolder.Subfolders
Set objFiles = objFolder.Files

If objFiles.Count = 0 and objSubfolders.Count = 0 Then
objFolder.Delete
End If

Set objFolder = Nothing
Set objSubfolders = Nothing
Set objFiles = Nothing
End Sub

Private Function CompareFileName (ByVal Name, ByVal Filter) ‘ (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = “.*” Then ‘ special case: “.*” at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = “.” Then ‘ special case: “.” at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case “*”
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case “?”
If np < = Len(Name) And Mid(Name,np,1) <> “.” Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ‘ skip over “*” and “?” characters in filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> “*” And fc2 <> “?” Then Exit Do
Loop
If fc2 = “.” Then
If Mid(Filter,fp) = “*” Then ‘ special case: “.*” at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ‘ special case: “.” at end of filter
CompareFileName2 = InStr(np0,Name,”.”) = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function

Similar Posts:

Popularity: 7% [?]

Tags: , , ,

Leave a Comment