VBA - Delete all files not containing certain string of text in filename

[gxm204]

I have a large collection of files (many thousands) and I only want to keep those containing a certain string in its filename (that is, "10-K".) Here is a picture of what I want do to -- except for those files containing "10_K" in the file name, delete the others. (This is a sampling of the directory -- there are many thousands of files in the entire folder.)

I cooked up a process for the time being but it is VERY tedious --

I used VBA to list all the file names in the folder. Then I used a "_" delimiter to parse the filename. Then I filtered out the files I wanted to delete, used a cell reference to fill in the absolute reference for the files, and then another macro to delete those files.

Here is the code for that...

YIKES!

Sub ListAllFile()


'Source: http://www.ozgrid.com/forum/showthread.php?t=65530
     
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add
     
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\QTR2")
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
     
     'Loop through the Files collection
    For Each objFile In objFolder.Files
        ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
    Next
     
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
     
End Sub
Sub DelFiles()


'Source: https://www.mrexcel.com/forum/excel-questions/777009-visual-basic-applications-delete-files-selected-ranges.html


Dim blnDelAll As Boolean
Dim rngVal As Range
Dim rngCl  As Range
Set rngVal = Columns("A").SpecialCells(xlCellTypeConstants)
On Error Resume Next
    For Each rngCl In rngVal.Cells
        Kill rngCl.Value
        If Err.Number <> 0 Then
            Err.Clear
            rngCl.Offset(, 1) = "File not found"
            blnDelAll = True
        End If
    Next
On Error GoTo 0
If blnDelAll Then
    MsgBox "Some File were not deleted, invalid path or you do not have permission to delete this file."
Else
    MsgBox "All Files successfully deleted."
End If
End Sub

 

[RCBricker]

would it not be easier to check for 10-K in the name with a loop and IF NOT kill the file?

so instead of your first sub, something like this:

Sub ListAllFile()


'Source: http://www.ozgrid.com/forum/showthread.php?t=65530
     
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set ws = Worksheets.Add
     
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\QTR2")
    'ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
     
     'Loop through the Files collection
    For Each objFile In objFolder.Files
        If Not InStr(1, objFile.Name, "10-K") > 0 Then
            Kill objFile
        End If
    Next
     
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
     
End Sub

*******Copy a couple files (10-Q and 10-K) to a new folder and test there.

 

[gxm204]

Yes, that is much better. Thank you.

One quirk -- this is also picking up files listed as "10-K-A" and "10-KT" -- how to tweak the VBA so it picks up only if the entire string is "10-K" and not just starts with "10-K"?

 

[RCBricker]

This will kill those two instances that you listed. If there are other instances, just keep adding to the Or section of the if statement.

Sub ListAllFile()


'Source: http://www.ozgrid.com/forum/showthread.php?t=65530
     
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set ws = Worksheets.Add
     
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\QTR2")
    'ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
     
     'Loop through the Files collection
    For Each objFile In objFolder.Files
        If Not InStr(1, objFile.Name, "10-K") > 0 Then
            Kill objFile
        Else
            If InStr(1, objFile.Name, "10-K-") > 0 Or _
                    InStr(1, objFile.Name, "10-KT") > 0 Then
            Kill objFile
        End If
    Next
     
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
     
End Sub

 

[TorqueMx]

Hi RCBricker,

Need you help on the below.

I checked your vba code for deleting all files not containing certain string of text in filename which was perfect.

Now I need to add some extra string of text. I tried editing your code but it seems it is still excluding the first string only.

Below is the code.

Sub Deletefiles()


Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")


Set objFolder = objFSO.GetFolder("C:\Data")


For Each objFile In objFolder.Files
If Not InStr(1, objFile.Name, "65489.AMR") > 0 Or _
InStr(1, objFile.Name, "64875.AMR") > 0 Or _
InStr(1, objFile.Name, "93481.AMR") > 0 Then
Kill objFile
End If
Next

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Sub



Can you help me with this.


Thanks in Advance!!

Regards,
TorqueMx

 

[RCBricker]

Hi RCBricker,

Need you help on the below.

I checked your vba code for deleting all files not containing certain string of text in filename which was perfect.

Now I need to add some extra string of text. I tried editing your code but it seems it is still excluding the first string only.

Below is the code.

Sub Deletefiles()


Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")


Set objFolder = objFSO.GetFolder("C:\Data")


For Each objFile In objFolder.Files
If Not InStr(1, objFile.Name, "65489.AMR") > 0 Or _
InStr(1, objFile.Name, "64875.AMR") > 0 Or _
InStr(1, objFile.Name, "93481.AMR") > 0 Then
Kill objFile
End If
Next

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Sub



Can you help me with this.


Thanks in Advance!!

Regards,
TorqueMx

TorqueMx,

I will try to help you, but I need you to start your own thread. I am pretty busy right now with year end. Starting your own thread will allow others to see that you need help.

 

[akshay27]

Sub ListAllFile()


'Source: http://www.ozgrid.com/forum/showthread.php?t=65530
  
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
  
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Set ws = Worksheets.Add
  
     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\QTR2")
    'ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
  
     'Loop through the Files collection
    For Each objFile In objFolder.Files
        If Not InStr(1, objFile.Name, "10-K") > 0 Then
            Kill objFile
        End If
    Next
  
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
  
End Sub

This is almost exactly what I was looking for! I have a couple of questions though.

I have

Public FilePath As String

and

FilePath = "C:\In Progress\"

earlier on in the code since it is used in multiple places and macros. How do I use the variable FilePath in here?

Set objFolder = objFSO.GetFolder("C:\QTR2")

Using anything but the absolute path throws an error.

I would like to display an alert that specifies which files will end up getting deleted and ask for user confirmation before the files are indeed killed. Something like

Response = MsgBox("Do you want the following files to be deleted automatically?" & List_of_Files, vbInformation + vbYesNo, 
"Are you sure you want to delete stuff")
If Response = vbYes
Then
Kill List_of_Files
End If

How can I set something like that up?