marcel1981
Apr 22, 2009, updated at Oct 18, 2012 (UTC)
view12530
view12
0
Goto Top

per VB Script leere (Unter)ordner löschen

GermansolvedQuestionVB for ApplicationsDevelopment
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
'*
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 114444

Url: https://administrator.de/contentid/114444

Printed on: April 26, 2024 at 06:04 o'clock

12 Comments
Latest comment
Goto Top
Member: AndreasHoster
AndreasHoster Apr 22, 2009 at 13:42:30 (UTC)
Goto Top
Ich sehe nicht, wo Du Ordner löschen willst, ich sehe nur ein datei.delete.
Member: Marcel1981
Marcel1981 Apr 22, 2009 at 13:46:16 (UTC)
Goto Top
Jetzt wo dus sagst ;)
Syntax?
Member: AndreasHoster
AndreasHoster Apr 22, 2009 at 14:06:20 (UTC)
Goto Top
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.
Member: bastla
bastla Apr 22, 2009, updated at Oct 18, 2012 at 16:38:02 (UTC)
Goto Top
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 face-wink) ...
Member: Marcel1981
Marcel1981 Apr 23, 2009 at 06:57:11 (UTC)
Goto Top
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
'*****************************************************************
Member: AndreasHoster
AndreasHoster Apr 23, 2009 at 07:31:07 (UTC)
Goto Top
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.
Member: Marcel1981
Marcel1981 Apr 23, 2009 at 07:38:34 (UTC)
Goto Top
Die Dateien sind raus aber die leeren Ordner bleiben bestehen face-sad
Member: AndreasHoster
AndreasHoster Apr 23, 2009 at 08:56:29 (UTC)
Goto Top
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
Member: Marcel1981
Marcel1981 Apr 23, 2009 at 12:16:47 (UTC)
Goto Top
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 face-sad
Member: AndreasHoster
AndreasHoster Apr 23, 2009 at 12:43:56 (UTC)
Goto Top
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.
Member: bastla
bastla Apr 23, 2009 at 13:54:07 (UTC)
Goto Top
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
Member: Marcel1981
Marcel1981 Apr 23, 2009 at 14:32:00 (UTC)
Goto Top
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
'*****************************************************************
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments