Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
564to568
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

wenn... dann springe dort hin "UweD hilfe"

wenn... dann springe dort hin "UweD hilfe"
10.02.2005 10:50:10
Alex
Hallo,
nachdem UweD vor ein paar Tagen so nett war und mir bei dem folgenden Code geholfen hat:

Sub killen()
'Dateien Älter als XX Tage werden gelöscht
Dim strPath$, strFile$, strExt$, Darf%, Alter As Date, JaNein
strPath = ActiveSheet.Range("D95").Value
If strPath = "" Then MsgBox "Bitte Pfad eintragen": Exit Sub
strExt = "*.txt"       'Dateiextension ggf. anpassen
Darf = ActiveSheet.Range("D94").Value 'Alter in Tagen
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Alter = FileDateTime(strPath & strFile)
If Date - Alter > Darf Then
JaNein = MsgBox("Soll Datei '" & strPath & strFile & "' gelöscht werden", vbYesNo, "Alte Dateien löschen")
If JaNein = vbYes Then Kill strPath & strFile
End If
strFile = Dir() ' nächste Datei
Loop
End If
End Sub

hätte ich noch gern eine ganz kleine Änderung im Code. Also diese Makro löscht alle Textdateien in einem Verzeichnis die älter sind als meine Vorgabe.
Bevor es die jeweilige Datei jedoch löscht, kommt nochmal eine Abfrage, ob sich der Benutzer auch sicher ist, das die Datei gelöscht werden soll. So weit so gut. Ich hätte jetzt gern die Option drin, dass wenn Zelle A1=1 ist diese Abfrage übersprungen wird, und alle alten Dateien ohne Rückfrage gelöscht werden.
Ich stell mir das so vor:

Sub killen()
'Dateien Älter als XX Tage werden gelöscht
Dim strPath$, strFile$, strExt$, Darf%, Alter As Date, JaNein
strPath = ActiveSheet.Range("D95").Value
If strPath = "" Then MsgBox "Bitte Pfad eintragen": Exit Sub
strExt = "*.txt"       'Dateiextension ggf. anpassen
Darf = ActiveSheet.Range("D94").Value 'Alter in Tagen
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Alter = FileDateTime(strPath & strFile)
If Date - Alter > Darf Then
JaNein = MsgBox("Soll Datei '" & strPath & strFile & "' gelöscht werden", vbYesNo, "Alte Dateien löschen")
If ActiveSheet.Range("A1").Value =1 Then Kill strPath & strFile
und Springe zur Marke1
End If
If JaNein = vbYes Then Kill strPath & strFile
End If
Marke1:
strFile = Dir() ' nächste Datei
Loop
End If
End Sub

Mein Problem ist die Syntax, ich kenn mich mit den Befehlen noch nicht so gut aus, kann mir da einer helfen?
Vielen Dank
Gruß

Alex

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: wenn... dann springe dort hin "UweD hilfe"
UweD
Hallo
so gehts:

Sub killen()
'Dateien Älter als XX Tage werden gelöscht
Dim strPath$, strFile$, strExt$, Darf%, Alter As Date, JaNein, Alle%
strPath = ActiveSheet.Range("D95").Value
If strPath = "" Then MsgBox "Bitte Pfad eintragen": Exit Sub
strExt = "*.txt"       'Dateiextension ggf. anpassen
Darf = ActiveSheet.Range("D94").Value 'Alter in Tagen
Alle = ActiveSheet.Range("A1").Value 'Alle löschen OHNE Sicherheitsabfrage
If strPath = "" Then
Exit Sub
Else
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Alter = FileDateTime(strPath & strFile)
If Date - Alter > Darf Then
If Alle <> 1 Then
JaNein = MsgBox("Soll Datei '" & strPath & strFile & "' gelöscht werden", vbYesNo, "Alte Dateien löschen")
If JaNein = vbYes Then Kill strPath & strFile
Else
Kill strPath & strFile
End If
End If
strFile = Dir() ' nächste Datei
Loop
End If
End Sub

Gruß UweD
Anzeige
AW: wenn... dann springe dort hin "UweD hilfe"
Alex
Alles klar, vielen Dank funktioniert sehr gut.
Gruß
Alex

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige