Option
Explicit
Sub
Bsp()
Dim
strFolder
As
String
strFolder = "X:\Hauptverzeichnis\"
If
Right$(strFolder, 1) <> "\" _
Then
strFolder = strFolder & "\"
Dim
objFSO
As
Object
Dim
objFolder
As
Object
Dim
objSubFolder
As
Object
Set
objFSO = CreateObject(
"Scripting.FileSystemObject"
)
If
Not
objFSO.FolderExists(strFolder)
Then
Call
MsgBox(
"Verzeichnis '"
& strFolder &
"' existiert nicht."
, vbExclamation)
Exit
Sub
End
If
Set
objFolder = objFSO.GetFolder(strFolder)
For
Each
objSubFolder
In
objFolder.SubFolders
If
objSubFolder.Files.Count = 0 _
And
objSubFolder.SubFolders.Count = 0 _
Then
Debug.Print
"lösche leeres Verzeichnis '"
& objSubFolder.Path &
"'"
Call
objSubFolder.Delete
End
If
Next
End
Sub