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
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"hurlbut777" <(E-Mail Removed)> wrote in message news:56E27A91-13B2-4A89-9B03-(E-Mail Removed)...
>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.
Similar Threads
