VBA: Excel macro to delete files in a unless the filename contains a string in the cell contents

Question

Trying to build my first VBA app. What I'm trying to achieve is:

• Values are entered in Column A
• VBA looks in a set file directory
• Compares what is in the file directory to the values in Column A.
• Deletes the file if the file name does not have a string similar to that listed in Column A.

I have attempted to piece together a few ideas listed all over the Internet but keep getting stuck. Here is what I have so far.

Private Sub CommandButton1_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

Dim strArray() As String
Dim TotalRows As Long
Dim i As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\z002vbrx\Desktop\test1")

TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim strArray(1 To TotalRows)

    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value
    Next
Debug.Print "Loaded " & UBound(strArray) & " items from speadsheet"

For Each objFile In objFolder.Files
   If InStr(1, objFile.Name, strArray) > 0 Then
       Debug.Print "something is being selected to be deleted."

      End If
   Next

MsgBox "Complete"
End Sub

What I am running into, is the strArray is suppose to grab all the data in the spreadsheet and create an array. But when I try to pass that array to anything I always get a Type Mismatch error. I'm not even sure if the 2nd half of the code that compares and will eventually delete files will work with an array. I know it does work with a single value.

Answer 1

Like Tim has mentioned, you need to loop each element in the array strArray and compare it with the file name. You will also need to modify your comparison value, as InStr will return 0 if the current element is it not part of the file name. I suggest having it break out of the check if it returns > 0.

Answer 2

Here is the solution I came up with and hope this helps someone else out! Please let me know if you have any suggestions on how to improve the code.

This will scan the folder location that is provided on Sheet1 E3 The filenames will be added to Sheet2 Column A Each cell's string in Sheet1 Column A will be compared to to Sheet 2 Column A and flagged as Good Then, anything not marked Good gets flagged as Bad Lastly, we scan back through Sheet2 Column A looking for cells marked as Bad and compare the names to the files and delete the file.

Private Sub CommandButton1_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim j As Long
Dim l As Long
Dim lr1 As Long
Dim lr2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ws1.Cells(3, 5).Value)
i = 1

'Scan through the folder and list files in Sheet2, column A
For Each objFile In objFolder.Files
    ws2.Cells(i + 1, 1) = objFile.Name
    i = i + 1
Next objFile

'Setup the sheets
lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

For l = 2 To lr1
    ws1.Cells(l, 1).Style = "normal"
Next l

For j = 2 To lr2
    ws2.Cells(j, 1).Style = "normal"
Next j

'Check cell string in Sheet1 column A against file names
'in Sheet2 column A and flag both Good
For l = 2 To lr1
cell1 = ws1.Cells(l, 1).Value
    For j = 2 To lr2
    cell2 = ws2.Cells(j, 1).Value
    If InStr(1, cell2, cell1) > 0 Then
        ws1.Cells(l, 1).Style = "Good"
        ws2.Cells(j, 1).Style = "Good"
        End If
    Next j
Next l

'Scan both Sheets 1 and 2 for unmarked cells and flag Bad
For l = 2 To lr1
style1 = ws1.Cells(l, 1).Style
    If style1 = "Normal" Then
        ws1.Cells(l, 1).Style = "Bad"
    End If
Next l

For j = 2 To lr2
style2 = ws2.Cells(j, 1).Style
    If style2 = "Normal" Then
        ws2.Cells(j, 1).Style = "Bad"
        End If
Next j

'Delete files if Sheet2 Column A cells are marked Bad and the
'cell string matches the file name
For j = 2 To lr2
    cell2 = ws2.Cells(j, 1).Value
    style2 = ws2.Cells(j, 1).Style
    For Each objFile In objFolder.Files
        If style2 = "Bad" And objFile.Name = cell2 > 0 Then
            Kill objFile
            End If
        Next objFile
Next j


MsgBox "Complete"
End Sub