トリプルループで空のフォルダを削除する

Question

トリプルループで空のフォルダを削除しようとしています。

注文番号： 1.メインフォルダに入力します。 2.最初に見つかったフォルダ を確認します。3.メインフォルダの最初のサブフォルダを確認します。 4.そのサブフォルダに別のフォルダが含まれている場合は、このサブサブフォルダ に入力します。5.最後のフォルダで何も含まれていない場合は、プログラムによって削除されます。 5.1フォルダに何かが含まれている場合（ファイル、Excel、pdfは関係ありません）、次のsubSubFolderに移動します。 6.空のフォルダがなくなるまで続けます。

基本的に、コードには、ファイルを含むフォルダは変更されていない必要があります。

しかし、なぜコードが続かず、空のコードを削除せずに停止するのか分かりません。

これは、フォルダ構造です： Folder 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

それは後で空の場合は（それは同様のルートフォルダが削除され、あなたが再帰的なコードをトレースバックになっている場合、それは心のブログをすることができ作業テスト、コードの下に試してみてください

サンプル - 唯一の空のテキストファイル。

そしてイミディエイトウィンドウは、ARのフォルダを示しています。ハイライト表示されたフォルダ内に（他のすべてのファイルがありません）、フォルダが残って実行されたコードの後

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 

ことですe deleted：