Code to delete excel file list from folders and sub folders

[evdejesus10]

I need to know if there is VBA code that will allow me to delete files from a specified folder or group of folders based on a list of file names in Excel. I frequently find myself needing to do this.

For example: I have a folder that has about 100 other folders in it. Within the those folders there are many files and folders. I need to be be able to delete a file from each folder based on a list of file names I have in col A on Sheet1. In other words, I need the macro to search through the specified folders and when it finds a file on the list, delete it.

 

[DanteAmor]

Hi and welcome to MrExel!

Do the following:
1. In column A, of Sheet1, starting in row 2 put the names of the files.
2. The file names must have the extension.
3. Run the macro "delete_excel_file" and select the initial folder where you want to start the search.
4. The macro will search all subfolders.
5. Plus, in column B, if the file was deleted, the message "Excel file deleted from folder:" will appear.
6. Put all the code in a module:

Option Explicit

Dim xfolders As New Collection

Sub Buscar_Fichas_de_Datos()
  Dim arch As Variant, xfold As Variant
  Dim sPath As String
  Dim sh As Worksheet
  Dim dic As Object
  Dim c As Range
  
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Select the initial folder"
      If .Show <> -1 Then Exit Sub
      sPath = .SelectedItems(1) & "\"
    End With
  End With

  Set sh = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(3))
    dic(c.Value) = c.Row
  Next
  
  xfolders.Add sPath
  Call AddSubDir(sPath)
  
  For Each xfold In xfolders
    arch = Dir(xfold & "\*.xls*")
    Do While arch <> ""
      If dic.exists(arch) Then
        sh.Range("B" & dic(arch)).Value = "Excel file deleted from folder: " & xfold
        Kill xfold & "\" & arch
      End If
      arch = Dir()
    Loop
  Next
  Set sh = Nothing
  Set dic = Nothing
End Sub
'
Sub AddSubDir(lPath As Variant)
  Dim SubDir As New Collection, DirFile As Variant, sd As Variant
  If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
  DirFile = Dir(lPath & "*", vbDirectory)
  Do While DirFile <> ""
    If DirFile <> "." And DirFile <> ".." Then
      If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then
        SubDir.Add lPath & DirFile
      End If
    End If
    DirFile = Dir
  Loop
  For Each sd In SubDir
    xfolders.Add sd
    Call AddSubDir(sd)
  Next
End Sub

 

[evdejesus10]

Hi DanteAmor! Thanks for your response. I am having an error that says Runtime error 53: file not found. I selected the main folder which has my files and subfolder in it which I need to delete. I click on debug and it highlighted in yellow this line If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then. Im new with macro so not really sure how to fix it.

 

[DanteAmor]

Run the macro again and when the error occurs, position the mouse over the variables lPath and DirFile, a value should appear in a small window, write those values here.

 

[evdejesus10]

I'm still having an error, It says Object doesn't support this property or method. I tried manipulating that line like the following:
SubDir.lPath = "D:\SOLAuser6\desktop\SPI-BRC\Design Team Folder - Documents\WORK PACKAGE\Tender Packages\BC 803\ID (CASAS)\BOH\01_BASEMENT\01_BOH TOILETS (BASEMENT)\"irFile

SubDir.lPath = "D:\SOLAuser6\desktop\SPI-BRC\Design Team Folder - Documents\WORK PACKAGE\Tender Packages\BC 803\ID (CASAS)\BOH\01_BASEMENT\01_BOH TOILETS (BASEMENT)\" & DirFile

SubDir.lPath = "D:\SOLAuser6\desktop\SPI-BRC\Design Team Folder - Documents\WORK PACKAGE\Tender Packages\BC 803\ID (CASAS)\BOH\01_BASEMENT\01_BOH TOILETS (BASEMENT)" & DirFile = "SOLN-CD-ID-CAS-B1M-43905 REV 0 ENLARGED BOH MALE TOILET (B1M-070) SET OUT, WALL TYPE, FF&E, EE & MECH & RCP 0.pdf"

Please don't laugh. ?

 

[DanteAmor]

Code to delete excel file list

RCP 0.pdf"

If you want to delete any file, excel or pdf or whatever, only I adjusted this part:
arch = Dir(xfold & "\*.*")

Try again:

Option Explicit

Dim xfolders As New Collection

Sub delete_excel_file()
  Dim arch As Variant, xfold As Variant
  Dim sPath As String
  Dim sh As Worksheet
  Dim dic As Object
  Dim c As Range
  
  With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Select the initial folder"
      If .Show <> -1 Then Exit Sub
      sPath = .SelectedItems(1) & "\"
    End With
  End With

  Set sh = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(3))
    dic(c.Value) = c.Row
  Next
  
  xfolders.Add sPath
  Call AddSubDir(sPath)
  
  For Each xfold In xfolders
    arch = Dir(xfold & "\*.*")
    Do While arch <> ""
      If dic.exists(arch) Then
        sh.Range("B" & dic(arch)).Value = "Excel file deleted from folder: " & xfold
        Kill xfold & "\" & arch
      End If
      arch = Dir()
    Loop
  Next
  Set sh = Nothing
  Set dic = Nothing
End Sub
'
Sub AddSubDir(lPath As Variant)
  Dim SubDir As New Collection, DirFile As Variant, sd As Variant
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")

  If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
  DirFile = Dir(lPath & "*", vbDirectory)
  Do While DirFile <> ""
    If DirFile <> "." And DirFile <> ".." Then
      If fso.FolderExists(lPath & DirFile) Then
      'If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then
        SubDir.Add lPath & DirFile
      End If
    End If
    DirFile = Dir
  Loop
  For Each sd In SubDir
    xfolders.Add sd
    Call AddSubDir(sd)
  Next
End Sub

 

[evdejesus10]

Hi again, sorry for my late response. I tried the new code and got an error "file not found". When I click debug, it highlighted yellow this line Kill xfold & "\" & arch.
I double-check the file and I'm sure it exists. The filename is also perfectly the same as it is written in my excel list. I appreciate your patience.

 

[DanteAmor]

Run the macro again and when the error occurs, position the mouse over the variables xfold and arch, but from this line

Kill xfold & "\" & arch

Take note of the content of the variables and paste it here

 

[na2000]

Hi Dante
im wondering is there a way to also delete the sub folder.
Im still quite new to this so many thanks if you can help