VBA to delete files that are not shared between two folders

B

Bamh1

New Member
Joined
Oct 7, 2021
Messages
40
Office Version
  1. 2016
Platform
  1. Windows
  2. Mobile
Hello,

I have two folders that contain a number of .xlsx files. Some of the files in Folder1 are also found in Folder2. I want to keep the files that are common in both folders, and delete the rest from both folders. I am thinking of something like:

Sub DelNotFoundFiles()

Dim Folder1 As String, Folder2 As String
Dim FileName1 As Object, FileName2 As Object
Dim Item As Object

Folder1 = "Z:\Path-to the-folder1\"
Folder2 = "Z:\Path-to-the-folder2\"

FileName1 = Dir(Folder1 & "*.xlsx")
FileName2 = Dir(Folder2 & "*.xlsx")

For Each Item In FileName1
If Not FileName2.Exists Then
FileName1.Delete ' Can repeat execution of the code with the folder names switched, but Ideally code differently to delete uncommon files in both folders at the same time
End If
Next

End Sub

Could someone please help fix the template above.

Thank you,

Shawn
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Hey Bahm1, check the code below!

VBA Code: 
Sub DeleteExtraFiles()
    'Declare variables for the two folders
    Dim folder1 As String, folder2 As String
    'Set the values for the folders
    folder1 = "PATH FOR THE FIRST FOLDER"
    folder2 = "PATH FOR THE SECOND FOLDER"

    'Declare variables for the file lists
    Dim files1 As New Collection, files2 As New Collection
    'Get the lists of files in each folder
    GetFiles folder1, files1
    GetFiles folder2, files2

    'Declare a variable for the current file
    Dim file As Variant
    'Loop through each file in Folder1
    For Each file In files1
        'Check if the file is also in Folder2
        If Not IsInCollection(file, files2) Then
            'If not, delete it from Folder1
            Kill folder1 & "\" & file
        End If
    Next file

    'Loop through each file in Folder2
    For Each file In files2
        'Check if the file is also in Folder1
        If Not IsInCollection(file, files1) Then
            'If not, delete it from Folder2
            Kill folder2 & "\" & file
        End If
    Next file
End Sub

'Function to get the list of files in a folder
Sub GetFiles(folder As String, files As Collection)
    'Declare a variable for the file system object
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Declare a variable for the folder object
    Dim fldr As Object
    Set fldr = fso.GetFolder(folder)

    'Declare a variable for the file object
    Dim file As Object
    'Loop through each file in the folder
    For Each file In fldr.files
        'Add the file name to the list
        files.Add file.Name
    Next file
End Sub

'Function to check if a file is in a collection
Function IsInCollection(file As Variant, files As Collection) As Boolean
    'Declare a variable for the current item
    Dim item As Variant
    'Loop through each item in the collection
    For Each item In files
        'If the item matches the file name, return True
        If item = file Then
            IsInCollection = True
            Exit Function
        End If
    Next item
    'If no match was found, return False
    IsInCollection = False
End Function
 
Upvote 0
bferraz said:
Hey Bahm1, check the code below!

VBA Code: 
Sub DeleteExtraFiles()
    'Declare variables for the two folders
    Dim folder1 As String, folder2 As String
    'Set the values for the folders
    folder1 = "PATH FOR THE FIRST FOLDER"
    folder2 = "PATH FOR THE SECOND FOLDER"

    'Declare variables for the file lists
    Dim files1 As New Collection, files2 As New Collection
    'Get the lists of files in each folder
    GetFiles folder1, files1
    GetFiles folder2, files2

    'Declare a variable for the current file
    Dim file As Variant
    'Loop through each file in Folder1
    For Each file In files1
        'Check if the file is also in Folder2
        If Not IsInCollection(file, files2) Then
            'If not, delete it from Folder1
            Kill folder1 & "\" & file
        End If
    Next file

    'Loop through each file in Folder2
    For Each file In files2
        'Check if the file is also in Folder1
        If Not IsInCollection(file, files1) Then
            'If not, delete it from Folder2
            Kill folder2 & "\" & file
        End If
    Next file
End Sub

'Function to get the list of files in a folder
Sub GetFiles(folder As String, files As Collection)
    'Declare a variable for the file system object
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Declare a variable for the folder object
    Dim fldr As Object
    Set fldr = fso.GetFolder(folder)

    'Declare a variable for the file object
    Dim file As Object
    'Loop through each file in the folder
    For Each file In fldr.files
        'Add the file name to the list
        files.Add file.Name
    Next file
End Sub

'Function to check if a file is in a collection
Function IsInCollection(file As Variant, files As Collection) As Boolean
    'Declare a variable for the current item
    Dim item As Variant
    'Loop through each item in the collection
    For Each item In files
        'If the item matches the file name, return True
        If item = file Then
            IsInCollection = True
            Exit Function
        End If
    Next item
    'If no match was found, return False
    IsInCollection = False
End Function
Click to expand...
Thank you very much for your prompt response, bferraz. I ran the code, but it gives me a run time error '53', file not found. I debugged, and it highlights Kill folder2 & "\" & file
 
Upvote 0
msg deleted. code not working
 
Last edited:
Upvote 0
Can you debug to see what variables folder2 and file are resulting?
 
Upvote 0
Did you change both paths (folder1 and folder2) according to your needs, right?
 
Upvote 0
Bamh1 said:
run time error '53', file not found. I debugged, and it highlights Kill folder2 & "\" & file
Click to expand...
Remove the & "\" if your folder2 string already ends with a back slash.

Alternatively, here's a simpler method.

VBA Code: 
Public Sub Delete_Files_Not_In_Both_Folders()

    Dim FSO As Object
    Dim FSfolder1 As Object, FSfolder2 As Object
    Dim FSfile As Object
    Dim folder1 As String, folder2 As String
    
    folder1 = "C:\path\to\folder1"   'CHANGE THIS
    folder2 = "C:\path\to\folder2"   'CHANGE THIS
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set FSfolder1 = FSO.GetFolder(folder1)
    Set FSfolder2 = FSO.GetFolder(folder2)
    
    For Each FSfile In FSfolder1.Files
        If Not FSO.FileExists(FSfolder2.Path & "\" & FSfile.Name) Then
            FSfile.Delete
        End If
    Next
            
    For Each FSfile In FSfolder2.Files
        If Not FSO.FileExists(FSfolder1.Path & "\" & FSfile.Name) Then
            FSfile.Delete
        End If
    Next
            
End Sub
 
Upvote 0
John_w said:
Remove the & "\" if your folder2 string already ends with a back slash.

Alternatively, here's a simpler method.

VBA Code: 
Public Sub Delete_Files_Not_In_Both_Folders()

    Dim FSO As Object
    Dim FSfolder1 As Object, FSfolder2 As Object
    Dim FSfile As Object
    Dim folder1 As String, folder2 As String
   
    folder1 = "C:\path\to\folder1"   'CHANGE THIS
    folder2 = "C:\path\to\folder2"   'CHANGE THIS
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    Set FSfolder1 = FSO.GetFolder(folder1)
    Set FSfolder2 = FSO.GetFolder(folder2)
   
    For Each FSfile In FSfolder1.Files
        If Not FSO.FileExists(FSfolder2.Path & "\" & FSfile.Name) Then
            FSfile.Delete
        End If
    Next
           
    For Each FSfile In FSfolder2.Files
        If Not FSO.FileExists(FSfolder1.Path & "\" & FSfile.Name) Then
            FSfile.Delete
        End If
    Next
           
End Sub
Click to expand...
Thank you very much John, for the comment on the previous code and for the alternative code; it works perfectly.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
VBA-Photos to be imported from Sharepoint Site rather than local drive
Replies
1
Views
205
Micron
M
D
  • Question
Merge Workbooks from Multiple Folders Based on by reading Order Numbers in Excel file
Replies
1
Views
496
ExcelToDAX
E
B
  • Solved
VBA to copy a row of Excel files from one folder to another
Replies
7
Views
661
Bamh1
B
D
  • Solved
Trying to Create Folder and Save to Folder based on cell values
Replies
8
Views
770
DeeMan
D
P
  • Question
Delete File or Folder VBA Issue
Replies
4
Views
493
Domenic
D

Forum statistics

Threads
1,215,866
Messages
6,127,403
Members
449,382
Latest member
DonnaRisso

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top