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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
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

mmn1000
  • Question Question
List folders and files
Replies
1
Views
846
Fuji
F
S
  • Question Question
Adding a new field to the results of my "list the folders inside a specific folder" code
Replies
2
Views
323
John_w
J
R
  • Question Question
Add a code or number at the end of the file name using VBA (Looped)
Replies
3
Views
122
HighAndWilder
H
J
  • Question Question
VBA Create folder and sub folder
Replies
8
Views
132
jdluke6545
J
C
  • Question Question
VBA-Photos to be imported from Sharepoint Site rather than local drive
Replies
1
Views
648
Micron
M

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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