三重循环删除空文件夹

我试图删除那些空的三重循环的文件夹。

顺序是：1.进入主文件夹。 2.检查第一个遇到的文件夹3.检查主文件夹的第一个子文件夹。 4.如果该子文件夹包含另一个文件夹，请input此子文件夹5.如果它是最后一个文件夹并且不包含任何内容，程序将删除它。 5.1如果文件夹包含一些东西（文件，excel，pdf，无所谓），只需转到下一个subSubFolder。 6.继续，直到没有空文件夹。

基本上，代码必须保持不变，包含文件的文件夹。

但我不知道为什么代码不会继续，只是停止不删除空的。

这是文件夹结构： 文件夹path

这是我使用的代码：

Sub recursiveDeleting() Dim sFldr As Object Dim ssFldr As Object Dim sssFldr As Object Dim fs Set fs = CreateObject("Scripting.FileSystemObject") sFound = False ssFound = False sssFound = False flPath = ActiveWorkbook.Path & "\" YearPath = flPath & "2017\" FARFIpath = YearPath & "\FAR_FI\" For Each sFldr In CreateObject("Scripting.FileSystemobject").GetFolder(FARFIpath).SubFolders For Each ssFldr In CreateObject("Scripting.FileSystemobject").GetFolder(sFldr).SubFolders For Each sssFldr In CreateObject("Scripting.FileSystemobject").GetFolder(ssFldr).SubFolders If Dir(sssFldr & "\*.*") = "" Then RmDir (sssFldr) Else sssFound = True End If If sssFound = True Then Exit For End If Next sssFldr If fs.FolderExists(ssFldr) = "" Then RmDir (ssFldr) Else ssFound = True End If If ssFound = True Then Exit For End If Next ssFldr If Dir(sFldr, vbDirectory) = "" Then RmDir (sFldr) sFound = True End If If sFound = True Then Exit For End If Next sFldr End Sub 

谢谢你的时间，祝你有美好的一天！

Answer 1

尝试下面的代码，testing工作（它会删除根文件夹，如果它后面是空的。如果你要追溯recursion的代码可以记住博客。

示例 – 突出显示的文件夹中只有一个空白文本文件（所有其他文件没有文件）。

 Option Explicit Private oFSO As Object Sub DeleteEmptyFolder() Dim oRootFDR As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Set oRootFDR = oFSO.GetFolder("C:\Test\mount") '<--- Change to your root folder If DeleteEmptyFolderOnly(oRootFDR) Then oRootFDR.Delete End If Set oRootFDR = Nothing Set oFSO = Nothing End Sub Private Function DeleteEmptyFolderOnly(ByRef oFDR As Object) As Boolean Dim bDeleteFolder As Boolean, oSubFDR As Object bDeleteFolder = False ' Recurse into SubFolders For Each oSubFDR In oFDR.SubFolders If DeleteEmptyFolderOnly(oSubFDR) Then Debug.Print "Delete", oSubFDR.Path ' Comment for production use oSubFDR.Delete End If Next ' Mark ok to delete when no files and subfolders If oFDR.Files.Count = 0 And oFDR.SubFolders.Count = 0 Then bDeleteFolder = True End If DeleteEmptyFolderOnly = bDeleteFolder End Function 

代码执行后，文件夹仍然是：

即时窗口显示被删除的文件夹：