Leere Ordner löschen

Guten morgen zusammen,
ich benötige bei einem Makro Hilfe. Auf meinem Rechner befinden sich sehr viele teilweise kleiner aber auch
größere Ordnerstrukturen. Folgendes soll das Makro können:
1. Der Explorer oder so soll geöffnet werden und ich kann eine vorhandene Ordnerstruktur auswählen.
2. Das Makro sucht in der ausgewählten Ordnerstruktur nach leeren Ordnern. Leer bedeutet, keine
Unterordner und auch keine anderen Dateien.
3. Werden keine leere Ordner gefunden, kommt eine MsgBox mit der Information: Keine leeren Ordner gefunden.
Werden leere Ordner gefunden, soll in einer MsgBox der Pfad angegeben werden wo sich der leere Ordner befindet.
Mit dem Button "löschen" soll der leere Ordner dann gelöscht werden. Mit dem Button "weiter" soll der Ordner
nicht gelöscht werden und das Makro soll weiter zum nächsten leeren Ordner springen.
Vorab Herzlichen Dank für Eure Unterstützung.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub loeschen() Set oFSO = CreateObject("Scripting.FileSystemObject") Set oSourceFolder = oFSO.GetFolder(pfad) For Each subpfad In oSourceFolder.Subfolders Debug.Print subpfad loeschen subpfad Next strFile = "\*.txt" strFound = Dir(pfad & strFile) Do While strFound "" Kill pfad & "\" & strFound strFound = Dir Loop If oSourceFolder.Files.Count = 0 And oSourceFolder.Subfolders.Count = 0 Then RmDir pfad End Sub

Hallo xtian,
hier mein Vorschlag für ein entsprechendes Makro.
Du kannst komplett mit dem SO arbeiten. Dir ist nicht erforderlich.
LG
Franz

'Ohne Verweis im VBA-Editor auf Microsoft Scripting Runtime
Sub prcLoeschen_leere_Ordner()
Dim varFolder
Dim FSO As Object, FSOFolder As Object, FSOSubFolder As Object
Dim intLeer%, intGeloescht%, intFolder%
Dim sMsgTitel As String
sMsgTitel = "L Ö S C H E N   L E E R E   O R D N E R"
Set FSO = VBA.CreateObject("Scripting.Filesystemobject")
Ordner_Auswahl:
intFolder = 0
intLeer = 0
intGeloescht = 0
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Löschen leere Ordner - übergeordneten Ordner auswählen"
If .Show = -1 Then
varFolder = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
Set FSOFolder = FSO.GetFolder(varFolder)
For Each FSOSubFolder In FSOFolder.SubFolders
intFolder = intFolder + 1
If FSOSubFolder.Files.Count = 0 And FSOSubFolder.SubFolders.Count = 0 Then
intLeer = intLeer + 1
If MsgBox("Folgenden UnterOrdner löschen?" & vbLf _
& FSOSubFolder.Name, _
vbOKCancel, sMsgTitel) = vbOK Then
FSOSubFolder.Delete
intGeloescht = intGeloescht + 1
End If
End If
Next
'Statistik anzeigen
If intLeer = 0 Then
If MsgBox("Durchsuchter Ordner " & vbLf _
& FSOFolder.Path & vbLf & vbLf _
& "Anzahl Unterordner: " & intFolder & vbLf _
& "Keine leeren Ordner gefunden", _
vbRetryCancel, sMsgTitel) = vbRetry Then GoTo Ordner_Auswahl
Else
If MsgBox("Durchsuchter Ordner " & vbLf _
& FSOFolder.Path & vbLf & vbLf _
& "Anzahl Unterordner: " & intFolder & vbLf _
& "Anzahl leere Unterordner: " & intLeer & vbLf _
& "Anzahl gelöschte Unterordner: " & intGeloescht, _
vbRetryCancel, sMsgTitel) = vbRetry Then GoTo Ordner_Auswahl
End If
Beenden:
Set FSO = Nothing: Set FSOFolder = Nothing: Set FSOSubFolder = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread