Office: (Office 2016) Leere Unterordner mit VBA rekursiv löschen

Helfe beim Thema Leere Unterordner mit VBA rekursiv löschen in Microsoft Access Hilfe um das Problem gemeinsam zu lösen; und c) Dim oFSO As FileSystemObject: "Benutzerdefinierter Typ nicht definiert". Verweis auf Scripting Runtime setzen oder Late Binding nutzen, steht... Dieses Thema im Forum "Microsoft Access Hilfe" wurde erstellt von jeepster, 2. August 2018.

Seite 2 von 3

EBS17

ebs17

Leere Unterordner mit VBA rekursiv löschen

und c)

Dim oFSO As FileSystemObject: "Benutzerdefinierter Typ nicht definiert".
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Verweis auf Scripting Runtime setzen oder Late Binding nutzen, steht im Code auch drin.

ebs17, 5. August 2018

#16
FRAESER

fraeser

Oh Gott,
Punkt c) hatte ich vergessen (Verweis) - trotz Klimaanlage :-)

fraeser, 5. August 2018

#17
JEEPSTER

jeepster

!!!Vielen Dank für Eure geduldige Hilfestellung!!!

Ich habe den Code von Beaker im Eigenschaftenblatt des Buttons Formular_schließen als Ereignisprozedur hinterlegt. Die 2. schließende Klammer in der If-Anweisung habe ich ergänzt. Das Ganze sieht jetzt so aus:

Private Sub Formular_schließen_Click()
Dim strPrüfideePfad As String
strPrüfideePfad = "C:UsersFDocumentsIdeenb?rse Ref. 4.2MaterialsammlungPrüfidee Nr._" & Me.Nummer
If Len(Dir(strPrüfideePfad, vbDirectory)) > 0 Then
Call LoescheLeereOrdner(strPrüfideePfad)
End If
DoCmd.Close acForm, Me.Name
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Sub von Marsu habe ich übernommen und sPath durch strPrüfideePfad ersetzt:

Public Sub LoescheLeereOrdner(ByVal strPrüfideePfad As String)
'Verweis auf "Microsoft Scripting Runtime" setzen oder auf LateBinding umstellen
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim oSubFolder As Folder

Set oFSO = New FileSystemObject
Set oFolder = oFSO.GetFolder(strPrüfideePfad)

'Rekursiver Aufruf fuer alle Unterordner
For Each oSubFolder In oFolder.SubFolders
Call LoescheLeereOrdner(oSubFolder.Path)
Next oSubFolder

'Wenn kein Unterordner und kein File vorhanden => loeschen
If oFolder.SubFolders.Count = 0 And oFolder.Files.Count = 0 Then
Debug.Print oFolder.Path 'Test
'foo.Delete 'wenn alles passt, scharf stellen
End If

'Aufraeumen
Set oSubFolder = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Häkchen Extras->Verweise->Microsoft Scripting Runtime ist gesetzt. Das Formular wird zwar geschlossen und es kommt auch keine Fehlermeldung mehr, aber die leeren Ordner bleiben bestehen.
Irgendwo ist noch der Wurm drin: *depressed
Gruß, jeepster

jeepster, 5. August 2018

#18
BEAKER S.A.

Beaker s.a.

Leere Unterordner mit VBA rekursiv löschen

Die 2. schließende Klammer
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

habe ich vergessen, sorry.
Hast du den Inhalt von "strPrüfideePfad" mit Debug.Print geprüft?

Beaker s.a., 5. August 2018

#19
MARSU65

Marsu65

aber die leeren Ordner bleiben bestehen.
Irgendwo ist noch der Wurm drin:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und zwar bewusst!
Bitte nicht nur Code blind kopieren, sondern auch versuchen ihn zu verstehen!
Sonst hast du irgendwann mal ein Format C: im kopierten Code oder es
werden Ordner gelöscht, die man noch braucht und das Geschrei ist groß.

Wenn du die beiden Zeilen
Code:

...
Debug.Print oFolder.Path 'Test
'foo.Delete 'wenn alles passt, scharf stellen
...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

verstanden hast und hier erklären kannst, kommst du von selbst auf die Lösung
oder bekommst weitere Hilfe dazu. Die Kommentare hab ich nicht aus Spaß am
Tippen hinzugefügt.

BTW: Code hier im Forum bitte in Code-Tags posten
Wie's geht, hast du bestimmt schon gelesen
Bitte vor der Benutzung des Forums lesen - Stand vom 18.09.2014

Marsu65, 5. August 2018

#20
MARKUSXY

markusxy

\@Marsu65,
ich frage mich immer, warum der rekursive Aufruf nicht mit Objekten geschieht, wenn man schon mit Objekten arbeitet.
Komischerweise findet man das in sämtlichen Anwendungbeispielen so.

Code:

Sub OrdnerLeerLöschen(ByVal Pfad As String)

OrdnerLeerLöschenHlp getFSO.GetFolder(Pfad)
End Sub
Private Sub OrdnerLeerLöschenHlp(FO As Scripting.Folder)
Dim SubFolder As Scripting.Folder

For Each SubFolder In FO.SubFolders
OrdnerLeerLöschenHlp SubFolder
Next

If FO.SubFolders.Count = 0 And FO.Files.Count = 0 Then FO.Delete
Set FO = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Im Prinzip genau das gleiche, nur das ich nicht jedes mal ein neues FSO erzeuge, was aus meiner Sicht auch überflüssig ist und vermutlich nur Ressourcen verschwendet.
Aber vielleicht sehe ich das auch falsch.

Das Konzept lässt sich natürlich bei jeder Art rekursiven Aufruf verwenden, der mit Objekten arbeitet.

LG M

markusxy, 5. August 2018

#21
JEEPSTER

jeepster

Zu Masus gestrigem Post versuche ich mich mal mit der erbetenen Erklärung:
Wenn ich den Button Formular_schließen betätigt habe und anschließend den Curser im VBA-Code in die Zeile
Code:

Debug.Print oFolder.Path 'Test
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

setze und dann Strg+G drücke, erscheint im VBA-Direktfenster der Pfad zum letzten von mir erzeugten leeren UnterUnterordner:
C:/Users/F/Ideenbörse Referat 4.2/Materialsammlung/Prüfidee Nr._6/Unterordner/UnterUnterordner. (Anm.: Ich habe in der Schreibweise "/", da Backslash nicht akzeptiert wird.)
Bis hier scheint also alles richtig zu sein. Im finalen Schritt müsste nun das 'foo in der Zeile Code:

'foo.Delete 'wenn alles passt, scharf stellen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ersetzt werden. Ich würde es durch oSubFolder ersetzen. Liege ich da richtig?
Danke & Gruß, jeepster

jeepster, 5. August 2018

#22
JEEPSTER

jeepster

Leere Unterordner mit VBA rekursiv löschen

Perfekt! Mit ... Code:

Debug.print oFolder.path
oFolder.Delete
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

funktioniert das rekursive Löschen leerer Unterordner nun einwandfrei!

Vielen Dank für Geduld!

jeepster, 6. August 2018

#23
OHRKESTER

Ohrkester

Servus jeepster und andere Suchende
das Ganze mal als kleine Beispiel DB aus den Codevorschlägen und kleinen Zusätzen..

Ohrkester, 6. August 2018

#24
MARSU65

Marsu65

\@jeepster
schön, hier auch mal eine steile Lernkurve zu sehen. *Smilie

@markus
Liegt wohl daran, dass i.d.R. 'mal eben' eine Sub/Function geschrieben wird,
welche die geforderte Funktionalität erfüllt. Den Beispielen fehlen meist auch das
Aufräumen der Objekte und eine Fehlerbehandlung.
... ein langer Weg zum perfect coding ... *wink.gif*

Marsu65, 6. August 2018

#25
LANZ RUDOLF

Lanz Rudolf

Hallo
@Ohrkester
Gratuliere:
habe Dein Code getestet Funktioniert Super *Smilie

Lanz Rudolf, 6. August 2018

#26
JOSEF P.

Josef P.

Hallo!

Eine weitere Variante:
Zuerst die obersten leeren Ordner ermitteln und anschließend diese löschen.
Prozedur zum Ermitteln der leeren Ordner kann für die Anzeige und fürs Löschen verwendet werden.

Prinzip:
Code:

Private Sub test()
LeereOrdnerLoeschen "(Ausgangspfad)"
End Sub

Public Sub LeereOrdnerLoeschen(ByVal StartPath As String)

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim StartFolder As Folder
Set StartFolder = fso.GetFolder(StartPath)

Dim f As Folder
Debug.Print "Leere Ordner:"
Debug.Print "---"
For Each f In GetTopFoldersOfEmptyFolders(StartFolder)
Debug.Print f.Name, f.Path
' fso.DeleteFolder f.Path
Next
Debug.Print "---"

End Sub

Public Function GetTopFoldersOfEmptyFolders(ByVal StartFolder As Folder) As Collection

Dim f As Folder
Dim sf As Folder
Dim EmptyFolders As Collection
Dim EmptySubFolders As Collection
Dim EmptyFirstLevelSubFolderCnt As Long

Set EmptyFolders = New Collection

If StartFolder.SubFolders.Count = 0 Then
If StartFolder.Files.Count = 0 Then
EmptyFolders.Add StartFolder, StartFolder.Path
End If
Set GetTopFoldersOfEmptyFolders = EmptyFolders
Exit Function
End If

For Each f In StartFolder.SubFolders
Set EmptySubFolders = GetTopFoldersOfEmptyFolders(f)
If EmptySubFolders.Count = 1 Then
Set sf = EmptySubFolders.Item(1)
If sf Is f Then ' Unterordner ist leer
EmptyFirstLevelSubFolderCnt = EmptyFirstLevelSubFolderCnt + 1
End If
EmptyFolders.Add sf, sf.Path
Else
For Each sf In EmptySubFolders
EmptyFolders.Add sf, sf.Path
Next
End If
Next

'Sonderbehandlung: alle Unterordner sind leer + keine Datei vorhanden
If EmptyFirstLevelSubFolderCnt = StartFolder.SubFolders.Count And StartFolder.Files.Count = 0 Then
Set EmptyFolders = New Collection
EmptyFolders.Add StartFolder
End If

Set GetTopFoldersOfEmptyFolders = EmptyFolders
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg
Josef

Josef P., 7. August 2018

#27
JEEPSTER

jeepster

Leere Unterordner mit VBA rekursiv löschen

Hallo Ohrkester,
wie müsste in deinem Beispiel die Zeile
Code:

Hauptordnerpfad = Nz(Me!AktenOrdner, "")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

aussehen, wenn ich einen fixen Pfad einsetzen möchte?
In meinem Falle sollen beim Schließen der Datenbank aus dem Hauptordner "Materialsammlung" mit dem Pfad "R:/Ideenbörse Referat 4.2/Materialsammlung" alle leeren Unterordner gelöscht werden. Im Moment wird mir beim Schließen leider auch der Hauptordner "Materialsammlung" gekillt.
Danke & Gruß, Hartmut

jeepster, 14. August 2018

#28
OHRKESTER

Ohrkester

Servus
Code:

Hauptordnerpfad = "R:/Ideenbörse Referat 4.2/Materialsammlung"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie sieht denn Dein gesamter Löschcode aus?
Es ist ja viel hier geschrieben worden und ich weiß nicht, welchen VBA-Code Du letztendlich angewendet hast.

Ohrkester, 15. August 2018

#29
JEEPSTER

jeepster

Der Button zum Schließen der DB ist mit folgenden Code verbunden:
Code:

Private Sub MicrosoftAccessBeenden_Click()

Dim Hauptordnerpfad As String
Hauptordnerpfad = "R:/Ideenbörse Referat 4.2/Materialsammlung"

LoescheLeereOrdner (Hauptordnerpfad)

Schliessen:
DoCmd.Quit
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dieser greift auf nachstehenden Code zu:
Code:

Public Sub LoescheLeereOrdner(ByVal sPath As String)
'Verweis auf "Microsoft Scripting Runtime" setzen oder auf LateBinding umstellen
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim oSubFolder As Folder

Set oFSO = New FileSystemObject
Set oFolder = oFSO.GetFolder(sPath)

'Rekursiver Aufruf fuer alle Unterordner
For Each oSubFolder In oFolder.SubFolders
Call LoescheLeereOrdner(oSubFolder.Path)
Next oSubFolder

'Wenn kein Unterordner und kein File vorhanden => loeschen
If oFolder.SubFolders.Count = 0 And oFolder.Files.Count = 0 Then
'Debug.Print oFolder.Path 'Test
oFolder.Delete 'wenn alles passt, scharf stellen
End If

'Aufraeumen
Set oSubFolder = Nothing
Set oFolder = Nothing
Set oFSO = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe zum Testen mehrere Unterordnerebenen (leer) unterhalb des Hauptordners "Materialsammlung" angelegt. Bei jedem Schließen der DB wird jeweils eine Unterordnerebene rekursiv gelöscht. Zu guter Letzt leider auch der Ordner "Materialsammlung" selber, wenn kein Unterordner mehr enthalten ist.

jeepster, 15. August 2018

#30

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 2 von 3

Thema:

Leere Unterordner mit VBA rekursiv löschen

Die Seite wird geladen...

Leere Unterordner mit VBA rekursiv löschen - Similar Threads - Leere Unterordner VBA
Leere Zeilen löschen
in Microsoft Word Hilfe
Leere Zeilen löschen: Hallo zusammen, ich arbeite gerade an einem VBA-Makro für Microsoft Word und komme einfach nicht weiter. Vielleicht kann mir hier jemand helfen? Was ich erreichen möchte: Ich möchte ein Makro...
automatisch gesetzte Seitenzahlen doppelt und danach leer
in Microsoft Word Hilfe
automatisch gesetzte Seitenzahlen doppelt und danach leer: Hallo und guten Morgen, ich muß nochmals ein Problem ansprechen. Ich denke, ich habe meine durchlaufende Seitennummerierung 'zerschossen'. Was ich zunächst geschafft hatte, war, dass ich die Seite...
Gelöscht-Ordner nach Datum leeren
in Microsoft Outlook Hilfe
Gelöscht-Ordner nach Datum leeren: Hallo Leute, ich bin der neu hier. Ich will meinen Ordner "Gelöschte Elemente" per Knopfdruck(Excel VBA) leeren. Dazu habe ich folgenden Code gefunden: Public Sub Geloeschte() Dim Out As...
Combox leere Zelle ignorieren
in Microsoft Excel Hilfe
Combox leere Zelle ignorieren: Guten Morgen, Ich steht auf dem Schlauch und komme nicht mehr weiter. Mein Problem, Auf Blatt1 habe ich 2 Comboboxen mit der ersten wähle den Typ von Maschine aus. Die Tabelle selber ist auf...
Leere Zelle farblich füllen
in Microsoft Excel Hilfe
Leere Zelle farblich füllen: Hallo an die Excel-Experten, ich möchte eine leere Zelle mit der Farbe der darüberstehende Zelle (mit Textinhalt) automatisch befüllen. Wenn in der leeren Zelle ein Text (Name) eingefügt wird, so...
leere Zelle in Zeile finden
in Microsoft Excel Hilfe
leere Zelle in Zeile finden: Hallo Liebe Excel Profis, ich bin noch recht unbedarft was VBA angeht. Man kopiert und liest und bastelt und versucht alles zu verstehen. Aber irgendwann kommt man nicht weiter. Ich habe eine...
VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen
in Microsoft Word Hilfe
VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen: Hallo zusammen, ich habe eine Word-Vorlage mit Platzhaltern, in die ich mit VBA Daten aus einer Excel-Datei einfüge (in eine Excel-Zeile schreibe ich alle Daten für ein neues Word-Dokument). So...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden