Delete empty folders in a directory

[SQUIDD]

Hi All

I'm trying to work out how to delete empty folders in a directory and sub folders

directory =" C:\OFFICE\PROJECT QUICK QUOTES"

i would like to delete all empty folders in this directory and any of the sub folders within

i have been unsuccessful, so asking for any help/ideas.

thanks

Dave

 

[Micron]

What you need is called a recursive function or sub. Sorry, but I don't have any examples and the only time I ever did this, I had to search for code because I'm not adept with recursive code. That one time was for MS Access.
You can research "excel vba recursive function" or "excel vba delete all empty folders" or similar. Or wait until someone smarter than me provides what you need.

 

[SQUIDD]

Micron

Thanks for the reply.
i realized i didn't need to go too deep into sub folders, and have managed to write a function that works.
Its clumsy, but works for me.
But thanks anyway for responding

Function DELETE_EMPTY_FOLDERS()
    Dim FSO As Object, MYDIR As Object, TEMPDIR As Object, FSOA As Object, TEMPDIRA As Object, FSOB As Object, TEMPDIRB As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSOA = CreateObject("Scripting.FileSystemObject")
    Set FSOB = CreateObject("Scripting.FileSystemObject")
    Set MYDIR = FSO.GetFolder(Mid(Sheets("DEFAULTS").Range("B3"), 1, Len(Sheets("DEFAULTS").Range("B3")) - 1) & "\PROJECT QUICK QUOTES")
    For Each TEMPDIR In MYDIR.SubFolders
        If Dir(TEMPDIR & "\PROJECTS", vbDirectory) = "" Then GoTo PASSER
        Set mydirA = FSOA.GetFolder(TEMPDIR & "\PROJECTS")
        For Each TEMPDIRA In mydirA.SubFolders
            i = 0
            Set MYDIRB = FSOB.GetFolder(TEMPDIRA)
            For Each TEMPDIRB In MYDIRB.SubFolders
                i = i + 1
            Next
            If i = 0 Then
                CreateObject("Scripting.FileSystemObject").DeleteFolder MYDIRB
            End If
        Next
PASSER:
    Next
    Set MYDIR = Nothing
    Set mydirA = Nothing
    Set MYDIRB = Nothing
    Set FSO = Nothing
    Set FSOA = Nothing
    Set FSOB = Nothing
End Function

 

[John_w]

You could try my solution too.

Public Sub Main_Delete_Empty_Subfolders()
       
    Delete_Empty_Subfolders "C:\OFFICE\PROJECT QUICK QUOTES"
            
    MsgBox "Done"
       
End Sub


Private Sub Delete_Empty_Subfolders(folderPath As String)

    Static FSO As Object 'Scripting.FileSystemObject
    Dim thisFolder As Object 'Scripting.Folder
    Dim subfolder As Object 'Scripting.Folder
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set thisFolder = FSO.GetFolder(folderPath)
        
    'Recurse to bottom of subfolder tree
    
    For Each subfolder In thisFolder.SubFolders
        Delete_Empty_Subfolders subfolder.Path
    Next
    
    'Delete this folder if it contains no subfolders and no files
    
    If thisFolder.SubFolders.Count = 0 And thisFolder.Files.Count = 0 Then
        thisFolder.Delete
    End If
    
End Sub

 

[SQUIDD]

Hi John

Thanks so much for posting your solution and taking the time to look.

I just tested this.
I setup some dummy folders in a new directory. OFFICE 1

I made 4 folders, with 2 sub folders in each, with 2 more sub folders within them.

everything got deleted, only directory that was left was OFFICE 1.
So not quite what i was after. As i needed the other folders to still remain, only folders that i wanted to delete was on the final tree.

Thanks

Dave

 

[John_w]

My code deletes all the subfolders starting at a specified folder if the subfolder is empty (the subfolder contains no files and no subfolders). If a parent folder becomes empty as a result of the macro deleting its subfolders then the parent folder is also deleted. Only the specified start folder is not deleted. That's the result you're seeing.

So do you want only the last folder(s) in the folder tree to be deleted, if they are empty?

 

[SQUIDD]

Hello John

So in folder "project quick quotes" are client name folders.

in "client name" folders 2 folders, 1 called "single job" and another called "projects"

in " projects" folder there are multiple folders project names. But at some point this is the folder that could become empty.

However, i always want to keep "single job" and "project", even if they are empty.

The folders i wish to remove simply reside in the "projects" folder, so if any folders in "projects" are empty, delete these.

Hope that makes sense.

PROJECT QUICK QUOTES main folder
LOTS OF CLIENT FOLDERS within above
SINGLE JOB/PROJECTS within above for all clients

PROJECTS
PROJECT A within projects, keep if files, delete if empty
PROJECT B within projects, keep if files, delete if empty
PROVETS C within projects, keep if files, delete if empty

full link where LF is client name

C:\OFFICE\PROJECT QUICK QUOTES\LF\PROJECTS\PROJECT A
C:\OFFICE\PROJECT QUICK QUOTES\LF\PROJECTS\PROJECT B
C:\OFFICE\PROJECT QUICK QUOTES\LF\PROJECTS\PROJECT C

My code is actually working, but probably taking the long route lol. But happy to leave it as it is.

thanks

Dave

 

[John_w]

My code is actually working, but probably taking the long route lol. But happy to leave it as it is.

Apart from the multiple FileSystemObject variables (only 1 is needed), your code is fairly efficient, with 3 nested loops.

I tried your code and, if I understand you correctly, it doesn't quite do what you describe. Using "PROJECT A" as an example, it deletes the "PROJECT A" subfolder if it contains no subfolders. But it also deletes "PROJECT A" if it contains any files but no subfolders, in which case "PROJECT A" isn't empty.

This code should do exactly what your macro does.

Public Sub Main_Delete_Empty_Projects()
       
    Delete_Empty_Projects "C:\OFFICE\PROJECT QUICK QUOTES"            
    MsgBox "Done"
       
End Sub

Private Sub Delete_Empty_Projects(folderPath As String)
    
    Static FSO As Object 'Scripting.FileSystemObject
    Dim thisFolder As Object 'Scripting.Folder
    Dim subfolder As Object 'Scripting.Folder
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    Set thisFolder = FSO.GetFolder(folderPath)
    
    For Each subfolder In thisFolder.SubFolders
        Delete_Empty_Projects subfolder.Path
    Next
          
    If StrComp(thisFolder.ParentFolder.Name, "Projects", vbTextCompare) = 0 Then
        If thisFolder.SubFolders.Count = 0 Then
            thisFolder.Delete
        End If
    End If
   
End Sub

If you want to delete "PROJECT A" (for example) only if it contains no files and no subfolders then change this line:

        If thisFolder.SubFolders.Count = 0 Then

to:

        If thisFolder.SubFolders.Count = 0 And thisFolder.Files.Count = 0 Then