Excel VBA loop through files in folder and delete if contains certain text

Is it possible to loop through a directory with subdirectories containing multiple .csv files and delete them if a certain text string is found inside each file?

yes, it is possible

Originally Posted by dOOb

yes, it is possible

Would anyone be willing to provide an example?

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

Hi !

For a faster process you can avoid external FileSystemObject library and just use Dir VBA function and Open statement …

That's true, but if speed is what you are after then I believe to start with you should filter these files out rather than loop through all subfolders, i.e.

Option Explicit
Sub RemoveCSVFiles()
Dim myWb As Workbook
Dim test_rng As Range
Dim search_rng As Range

Dim Fld_Path As String
Dim myStr As String
Dim i As Long
Dim FileCount As Long

Dim FilteredItems_arr

'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:")
    
'filter ".csv" files in the specified folder and its subfolders and write them to array
    FilteredItems_arr = Split(CreateObject("wscript.shell").exec ("cmd /c Dir """ & Fld_Path & "*.csv"" /b /s").stdout.readall, vbNewLine)

'turn off screen updating and display alerts settings
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

'loop through array
    For i = 0 To UBound(FilteredItems_arr) - 1

        Workbooks.Open FilteredItems_arr(i)
        Set myWb = Workbooks(Mid(FilteredItems_arr(i), InStrRev(FilteredItems_arr(i), "\") + 1))
        Set search_rng = Workbooks(myWb.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(myWb.Name).Close
        
        'delete file if string found
        If Not test_rng Is Nothing Then
            Kill FilteredItems_arr(i)
            FileCount = FileCount + 1
        End If
    Next i
    
'turn the app settings back on
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox FileCount & " files deleted."
    
End Sub