Delete certain files in all subfolders of specified folder

[hurlbut777]

I have a folder, C:\Test, that contains many subfolders. Within these
subfolders there are many excel files. I would like to build a macro that
loops through all excel files and subfolders within C:\Test, and deletes any
excel files that start with "ABC". I have read Churck Pearson' recursion
information, but am afraid I will start deleting stuff I shouldn't if I
attempt to rambo code on my own.

 

[Ron de Bruin]

Try this ?

Copy both macros in a standard module of your workbook
When you run the code you must select the root folder (the code ask you this)
(Test it with a backup folder)
Let me know if this is what you want


Private myFiles() As String
Private Fnum As Long

Sub RDB_Merge_Data_Browse()
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant
Dim I As Long

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=True, _
ExtStr:="ABC*.xl*")

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

For I = LBound(myFiles) To UBound(myFiles)
On Error Resume Next
Kill myFiles(I)
On Error GoTo 0
Next I

End If

End Sub


Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

Get_File_Names = Fnum
End Function


Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
End If
Next fileInSubfolder

Next SubFolder
End Sub

 

[Chip Pearson]

I have read Churck Pearson' recursion

Who?

The following code should work. Change the line marked with <<< to the
desired folder.

Sub DeleteABC()
Dim FSO As Scripting.FileSystemObject
Dim FF As Scripting.Folder
Set FSO = New Scripting.FileSystemObject
Set FF = FSO.GetFolder("C:\Test") '<<< Change Folder

DoOneFolder FF, FSO
End Sub

Sub DoOneFolder(FF As Scripting.Folder, FSO As
Scripting.FileSystemObject)
Dim SubF As Scripting.Folder
Dim F As Scripting.File
For Each F In FF.Files
If StrComp(Left(F.Name, 3), "ABC", vbTextCompare) = 0 Then
Recycle F.Path
End If
Next F
For Each SubF In FF.SubFolders
DoOneFolder SubF, FSO
Next SubF
End Sub

The DoOneFolder function uses the Recycle library, at
http://www.cpearson.com/Zips/modRecycleVBA.zip to send files to the
Windows Recycle Bin rather than using Kill do delete the file, so you
can get back any files that might be deleted. Unload and unzip the
link above and then Import (in VBA, File menu, Import File item) the
bas file into your project.

The code requires a reference (in VBA, Tools men, References item) to
the "Microsoft Scripting Runtime" library.

If you want to confirm each deletion, use the following:

Sub DoOneFolder(FF As Scripting.Folder, _
FSO As Scripting.FileSystemObject)
Dim Res As VbMsgBoxResult
Dim SubF As Scripting.Folder
Dim F As Scripting.File
For Each F In FF.Files
If StrComp(Left(F.Name, 3), "ABC", vbTextCompare) = 0 Then
Res = MsgBox("Delete file: '" & _
F.Path & "'?", vbYesNoCancel)
Select Case Res
Case vbYes
Recycle F.Path
Case vbNo
' do nothing
Case vbCancel
Exit Sub
End Select
End If
Next F
For Each SubF In FF.SubFolders
DoOneFolder SubF, FSO
Next SubF
End Sub



Cordially,
Chip Pearson
Microsoft MVP
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Ron de Bruin]

I like your new name Chip <g>

 

[Don Guillett]

Aw come on, Churck has a nice ring to it.
http://www.google.com/search?sourceid=navclient&ie=UTF-8&rlz=1T4GFRD_en___US219&q=churck

 

[hurlbut777]

Chip, I apologize as I meant no disrespect. Sadly, I messed up twice: the
first by thinking your name was Chuck, and the second by typing it as Churck.
At any rate, I appreciate everyone's help and will try the recommended code.

 

[hurlbut777]

Chip (Churck),

When I run the code it errors out on the first line (Dim FSO AS
Scripting.FileSystemObject) with the error "user-defined type not defined".
Any ideas on how to fix this?

Thanks