Here's one way to do it.
It needs the reference to Microsoft Scripting Runtime selected (early binding).
Select the top folder when prompted and the text string to look for, and it will loop through all subfolders and files looking for .csv files with the specified string in the active sheet*
* if there are multiple sheets in the file and you need it to search in all sheets, then let me know
Option Explicit
Dim FileCount As Long
Sub Folderloop()
Dim FSO As Scripting.FileSystemObject
Dim Fld_obj As Scripting.Folder
Dim File_obj As Scripting.File
Dim SubFolder As Object
Dim Fld_Path As String
Dim FilePath As String
Dim myStr As String
'select top folder
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then Fld_Path = .SelectedItems(1)
End With
' get string to look for
myStr = InputBox("Text string to look for:")
'turn off screen updating and display alerts settings
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fld_obj = FSO.GetFolder(Fld_Path)
'loop through subfolders
For Each SubFolder In Fld_obj.SubFolders
LoopThroughFiles SubFolder, myStr
LoopThroughSubFolders SubFolder, myStr
Next SubFolder
'loop through files in top folder
LoopThroughFiles Fld_obj, myStr
MsgBox FileCount & " files deleted."
FileCount = 0
'turn the app settings back on
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Sub LoopThroughSubFolders(myFolder As Scripting.Folder, myStr As String)
Dim SubFolder As Scripting.Folder
For Each SubFolder In myFolder.SubFolders
LoopThroughFiles SubFolder, myStr
LoopThroughSubFolders SubFolder, myStr
Next
End Sub
Sub LoopThroughFiles(myFolder As Scripting.Folder, myStr As String)
Dim f As Scripting.File
Dim test_rng As Range
Dim search_rng As Range
For Each f In myFolder.Files
If f.Name Like "*.csv" Then
'open file
Workbooks.Open f
Set search_rng = Workbooks(f.Name).ActiveSheet.UsedRange
'find string
With search_rng
Set test_rng = .Find( _
What:="*" & myStr & "*", _
After:=.Cells(.Cells.Count), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchOrder:=xlByRows)
End With
'close file
Workbooks(f.Name).Close
'delete file if string found
If Not test_rng Is Nothing Then
f.Delete
FileCount = FileCount + 1
End If
End If
Next
End Sub
Bookmarks