VBA to delete files that are not shared between two folders

[Bamh1]

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

 

[bferraz]

Hey Bahm1, check the code below!

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

 

[Bamh1]

Hey Bahm1, check the code below!

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

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

 

[Bamh1]

msg deleted. code not working

 

[Bamh1]

msg deleted

 

[bferraz]

Can you debug to see what variables folder2 and file are resulting?

 

[bferraz]

Did you change both paths (folder1 and folder2) according to your needs, right?

 

[John_w]

run time error '53', file not found. I debugged, and it highlights Kill folder2 & "\" & file

Remove the & "\" if your folder2 string already ends with a back slash.

Alternatively, here's a simpler method.

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

 

[Bamh1]

Remove the & "\" if your folder2 string already ends with a back slash.

Alternatively, here's a simpler method.

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

Thank you very much John, for the comment on the previous code and for the alternative code; it works perfectly.

 

[Bamh1]

Did you change both paths (folder1 and folder2) according to your needs, right?

Problem was the backslash as commented below.
Thanks,