per VB Script leere (Unter)ordner löschen

gelöstFrage VB for Applications Entwicklung

Hallo, bin schon länger im Netz und in meinem Gehirn auf der Suche, welches Dateien UND UNTERORDNER in einem von mir gewählten VZ löscht.
Mit Dateien funktioniert das einwandfrei, allerdings werden die dann leergewordenen (Unter)ordner nicht gelöscht.
Dies sollte eigentlich im unteren Teil des Scriptes passieren. Wo ist der (Denk)fehler?

'*
'
' Löscht alle Dateien, die seit einem bestimmten Datum
' nicht mehr geändert wurden (in diesem Bsp. ein Tag bzw. 24h)
'
'*
'
'*
dim fso
dim Verzeichnis(1)
Verzeichnis(0) = "D:\Temp\*"
Verzeichnis(1) = "D:\Temp1\*"

Aufheben = 1 'Anzahl Tage

'*

Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next

for n=0 to 2
Set ordner = fso.GetFolder(Verzeichnis(n))
jetzt = now()
DeleteInFolder(ordner)
next

Sub DeleteInFolder(ordner)
Set dateien = ordner.Files
' Alle Dateien in diesem Ordner abklappern
For Each datei In dateien
If datei.DateLastModified < (jetzt) Then
on error resume next
datei.delete
End If
Next
Set untere = ordner.SubFolders
'Unterordner abklappern, DeleteInFolder rekursiv aufrufen
For Each unter In untere
If Unter.DateCreated < (jetzt) Then
DeleteInFolder(Unter)
End If
Next
End Sub
'*

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 114444

Url: https://administrator.de/forum/per-vb-script-leere-unterordner-loeschen-114444.html

Ausgedruckt am: 23.04.2025 um 12:04 Uhr

12 Kommentare

Neuester Kommentar

Ich sehe nicht, wo Du Ordner löschen willst, ich sehe nur ein datei.delete.

Jetzt wo dus sagst ;)
Syntax?

Syntax: unter.delete
Allgemein: FolderObjekt.delete

Du müsstest halt vorher schauen, ob es Dateien oder Unterordner unter dem Ordner gibt.
Müsste man aber über FolderObjekt.SubFolders und FolderObjekt.Files rausbekommen.

Hallo Marcel1981!

Das Script erinnert ein wenig an diesen Beitrag - dort gibt es dann auch noch die Zeile

If (Unter.SubFolders.Count + Unter.Files.Count) = 0 Then Unter.Delete

zum Aurfäumen nach dem (rekursiven) Aufruf von "DeleteInFolder()" - sollte eigentlich auch hier passen ...

Grüße
bastla

P.S.: Wäre das Script mit -Formatierung gepostet, hätte ich auch gerne eine Zeilennummer für die Position zum Einfügen dieser Zeile vorgeschlagen (ist aber vermutlich auch ohne zu schaffen

) ...

Hallo zusammen!
Ich nehme an, da unten ist der Aufruf und die Syntax richtig, er tut aber einfach nicht.
Ausserdem meine ich, dass dort ein end if fehlt, nehme ich es rein meckert er aber "Anweisung erwartet"

'*****************************************************************  
'  
' Löscht alle Dateien, die seit einem bestimmten Datum  
' nicht mehr geändert wurden (in diesem Bsp. ein Tag bzw. 24h)  
'  
'*****************************************************************  
'  
'*****************************************************************  
dim fso
dim Verzeichnis(1)
Verzeichnis(0) = "D:\Temp\*"  
Verzeichnis(1) = "D:\Temp1\*"  

Aufheben    = 1 'Anzahl Tage  

'*****************************************************************  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set WSHShell = WScript.CreateObject("WScript.Shell")  
On Error Resume Next                                              

for n=0 to 2
	Set ordner = fso.GetFolder(Verzeichnis(n))
	jetzt = now()
	DeleteInFolder(ordner)
next

Sub DeleteInFolder(ordner)
	Set dateien = ordner.Files
	' Alle Dateien in diesem Ordner abklappern  
	For Each datei In dateien	  
          If datei.DateLastModified < (jetzt) Then
	    on error resume next
	     datei.delete	
	  End If
	Next
	Set untere = ordner.SubFolders
	'Unterordner abklappern, DeleteInFolder rekursiv aufrufen  
	For Each unter In untere
	  If Unter.DateCreated < (jetzt) Then 
	    DeleteInFolder(Unter) 	
	    If (Unter.SubFolders.Count + Unter.Files.Count) = 0 Then Unter.Delete
	  End If
	Next
End Sub
'*****************************************************************  

Ich habe das Skript ausprobiert, es funktioniert bei mir.
Die Frage ist, was genau tut nicht.
Löscht er Dateien nicht, Ordner nicht, beides nicht, alle nicht, nur bestimmte nicht ...

Zum End If wenn man den EINZIGEN Befehl im Then Block direkt dahinter schreibt, dann braucht man kein End if.
Und durch das On Error Resume Next bekommst Du auch gar nicht mit, wenn ein Fehler auftritt, z.B. Zugriff verweigert.

Die Dateien sind raus aber die leeren Ordner bleiben bestehen

Nein, bei mir hat er auch die Unterordner unterhalb der angegebenen Order gelöscht. Die angegebenen Ordner natürlich nicht. Ist auch nicht so programmiert

Ich habe mich falsch ausgedrückt:
Ordner Temp und Temp1 bleiben bestehen, ist ja so gewollt und wie du sagst auch so programmiert, aber wenn sich in diesen Ordnern nun (leere) Unterordner befinden, bleiben die auch nach ausführen des Scriptes bestehen. Das isses ja was mich so irre macht

Wie gesagt, an der Logik des Skriptes liegts nicht, da es bei mir tut.
Nimm mal die On Error Resume Next Anweisungen raus, dann müsste es Fehlermeldungen geben, wenn er den Delete nicht ausführen kann.

Hallo Marcel1981!

Eigentlich bin ich überrascht, dass überhaupt etwas gelöscht wird - der Stern am Ende der Pfadangaben in den Zeilen 11 und 12 gehört dort nicht hin und sorgt bei mir für die Fehlermeldung "Der Pfad wurde nicht gefunden." (was Du nur sehen wirst, wenn Du, wie AndreasHoster schon empfohlen hat, "On Error Resume Next" auskommentierst - in der Testphase eigentlich ohnehin Pflicht).

Außerdem gibt es kein Verzeichnis(2), was aufgrund der Schleife in Zeile 22 den nächsten Fehler produziert - besser wäre hier die Schreibweise

For n = 0 to UBound(Verzeichnis)

Ansonsten macht das Script auch bei mir, was es soll ...

Grüße
bastla

Hallo nochmal,

die Sternchen sind überbleibsel vom testen, genau wie die 2 bei n, im Grunde ist es eh nur ein VZ was "gesäubert werden soll.
Danke für eurer aller Mühe! So läuft es jetzt!

'*****************************************************************  
'  
' Löscht alle Dateien, die seit einem bestimmten Datum  
' nicht mehr geändert wurden (in diesem Bsp. ein Tag bzw. 24h)  
'  
'*****************************************************************  
'  
'*****************************************************************  
dim fso
dim Verzeichnis(1)
Verzeichnis(0) = "D:\Temp\"  
Verzeichnis(1) = "D:\Temp1\"  

Aufheben    = 1 'Anzahl Tage  

'***************************************************************16  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set WSHShell = WScript.CreateObject("WScript.Shell")  
On Error Resume Next                                              

for n=0 to 1
	Set ordner = fso.GetFolder(Verzeichnis(n))
	jetzt = now()
	DeleteInFolder(ordner)
next

Sub DeleteInFolder(ordner)
	Set dateien = ordner.Files
	' Alle Dateien in diesem Ordner abklappern  
	For Each datei In dateien	  
          If datei.DateLastModified < (jetzt-aufheben) Then
	    'on error resume next  
	     datei.delete	
	  End If
	Next
	Set untere = ordner.SubFolders
	'Unterordner abklappern, DeleteInFolder rekursiv aufrufen  
	For Each unter In untere
	  If Unter.DateCreated < (jetzt-aufheben) Then 
	    DeleteInFolder(Unter) 	
	    If (Unter.SubFolders.Count + Unter.Files.Count) = 0 Then Unter.Delete
	  End If
	Next
End Sub
'*****************************************************************  