Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ordnerpfade in Objekt schreiben, filtern und löschen

Ordnerpfade in Objekt schreiben, filtern und löschen
31.10.2019 19:26:49
Dominik
Guten Abend euch allen,
ich bin gerade am verzweifeln mit dem Umgang von Objekten in VBA. Folgendes möchte ich tun.
1.) Ich möchte alle die Pfade der Unterordner eines Dateipfades in ein Objekt schreiben.
2.) Anschließend möchte ich alle Pfade aus der "Liste" löschen bei denen die Benennung nicht zu einer vorgegebenen Definition passt.
3.) Dann möchte ich die letzten 5 Einträge ebenfalls noch aus der "Liste" löschen.
4.) Zuletzt möchte ich alle übrig gebliebenen Unterordner komplett löschen (inkl. aller Dateien)
Dadurch kann ich erreichen, dass immer die ältesten Ordner gelöscht werden. In den neueren Ordner befinden sich dann die aktuellen Sicherungen.
Folgendes habe ich schon geschafft (mit dem Code unten):
Ich kann schon alle Unterordner im Suchpfad auflisten und auch nach meinem ersten Kriterium "sortieren". Punkt 1 ist somit eigentlich erledigt (hab ich mir mal als Debug.Print ausgeben lassen). Ich habe dazu noch eine Funktion verwendet um den Ordnernamen zu ermittel und mit einer definierten Bennenung zu überprüfen. Somit kann ich sicherstellen, dass nicht versehntlich die falschen Ordner gelöscht werden. _
Das löschen aus dem Objekt bzw. der "Liste" funktioniert bisher aber nicht. Könnt Ihr mir weiterhelfen? Ich habe wirklich probleme zu versehen wie ich mit Objekten arbeite. Bei meiner Recherche habe ich zwar viel gefunden aber nichts was mir weiterhilft.
Vielen Dank euch schon jetzt. Ich wünsche euch ein schönes verlängertes Wochenende.

Sub AlteSicherungenLoeschen() 'Quelle https://www.herber.de/forum/archiv/572to576/ _
572340_Ordner_auflisten_aber_wie.html
Dim fso As Object
Dim myfolder As Object
Dim myfile As Object
Dim strOrdnerName As String
Dim strZiel
strZiel = "C:\Users\Dominik\Desktop\Test2\"
Set fso = CreateObject("scripting.filesystemobject")
Set myfolder = fso.GetFolder(strZiel)
For Each myfile In myfolder.SubFolders
strOrdnerName = NameOrdnerImZielErmitteln(CStr(myfile))   'Name des Sicherungsordners
If strOrdnerName Like "Sicherung-" & "*" Then           'prüfen ob es sich um  _
Sicherungsordner handelt
'Hier müssen noch die neusten 5 Ordner (die letzten 5 einträge in der "Liste" entfernt  _
werden) anschließend sollen die kompletten Pfade gelöscht werden
Debug.Print myfile & " löschen"
Else
'Diese Ordner können aus der Liste entfernt werden/ sollen nicht gelöscht werden
Debug.Print myfile & " nicht löschen"
End If
Next myfile
Set myfolder = Nothing
Set fso = Nothing
End Sub


Function NameOrdnerImZielErmitteln(strPfad As String) 'Quelle https://www.herber.de/forum/archiv/ _
424to428/427909_Text_mit_VBA_splitten.html

NameOrdnerImZielErmitteln = Right(strPfad, InStr(1, StrReverse(strPfad), "\") - 1)
End Function

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordnerpfade in Objekt schreiben, filtern und löschen
01.11.2019 14:49:03
Dominik
Guten Tag euch allen,
ich habe einen Weg für mein Problem gefunden und es nun hinbekommen. Sicherlich kann man hier noch viel optimieren (Benennungen, Länge und Aufbau,...). Nach ein Paar Test scheint es aber wie gewünscht zu funktionieren. Falls jemand den Code noch optimieren kann wäre ich dankbar. Ihr findet unten meine Lösung sowie die entsprechenden Link aus denen ich den Code "zusammengebaut" habe.
!!!Achtung!!!: Bitte den Code mit Vorsicht nochmal selbst versuchen. Die Löschenfunktion ist ohne doppelten Boden. Hierdurch entsteht eventuell Datenverlust.
Ich wünsche euch einen schönen Feiertag.
Gruß
Dominik
Sub AlteSicherungenLoeschen() 'Quelle https://www.herber.de/forum/archiv/572to576/572340_Ordner_auflisten_aber_wie.html
Dim fso As Object
Dim myfolder As Object
Dim myfile As Object
Dim strOrdnerName As String
Dim objPotenzielleListe As Object
Dim objPotenziellerPfad As Object
Dim intMax As Integer
Dim intBisEintragLoeschen As Integer
Dim intZaehler As Integer
Dim objLoeschenListe As Object
Dim objLoeschenPfad As Object
Dim strZiel
strZiel = "C:\Users\Dominik\Desktop\Test2"
If Right(strZiel, 1)  "\" Then strZiel = strZiel & "\" 'ggf. noch Schrägstrich hinzufüge
intMax = 0
intZaehler = 1
Set fso = CreateObject("scripting.filesystemobject")
Set myfolder = fso.GetFolder(strZiel)
Set objPotenzielleListe = CreateObject("Scripting.Dictionary")
Set objLoeschenListe = CreateObject("Scripting.Dictionary")
For Each myfile In myfolder.SubFolders                                                           _
'1.) Start: Nur Pfade die die richtig Bezeichnung haben auswählen
strOrdnerName = NameOrdnerImZielErmitteln(CStr(myfile))   'Name des Sicherungsordners
If strOrdnerName Like "Sicherung-" & "*" Then           'prüfen ob es sich um  _
Sicherungsordner handelt
'Debug.Print myfile & " löschen"
objPotenzielleListe.Add myfile, 1
Else
'Diese Ordner können aus der Liste entfernt werden/ sollen nicht gelöscht werden
'Debug.Print myfile & " nicht löschen"
End If
Next myfile                                                                                      _
'1.) Ende
intMax = objPotenzielleListe.Count '2.) Start: Die zu Löschenden Pfade siehe auch Quelle https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/dictionary-object
intBisEintragLoeschen = intMax - 2                                                           _
'Bestimmung der Anzahl an Pfade die bestehen bleiben sollten Maximale Anzahl im Ordner - Anzahl an verbleibenden Kopien
For Each objPotenziellerPfad In objPotenzielleListe                                              _
'2.) Nimmt in Liste zum Löschen nur die Pfade auf die gelöscht werden sollten
If intZaehler https://www.herber.de/forum/archiv/1264to1268/1265709_Ordner_per_VBA_loeschen.html
Case vbOK
For Each objLoeschenPfad In objLoeschenListe
Call AlleDateienLoeschen(CStr(objLoeschenPfad), True, True)   'Unterordner + Dateien im  _
Pfad löschen Überornder bleibt bestehen erstes True für Unterordner zweites True für Überordner
Next objLoeschenPfad
Case vbCancel
'keine Anweisung bisher
End Select                                                                                       _
'3.) Ende
Set myfolder = Nothing
Set fso = Nothing
Set myfile = Nothing
Set objPotenzielleListe = Nothing
Set objPotenziellerPfad = Nothing
Set objLoeschenListe = Nothing
Set objLoeschenPfad = Nothing
End Sub

Function NameOrdnerImZielErmitteln(strPfad As String) 'Quelle https://www.herber.de/forum/archiv/424to428/427909_Text_mit_VBA_splitten.html
NameOrdnerImZielErmitteln = Right(strPfad, InStr(1, StrReverse(strPfad), "\") - 1)
End Function

Function UebergeordnerterOrdnerPfadErmitteln(strPfad As String) 'Quelle https://www.herber.de/forum/archiv/424to428/427909_Text_mit_VBA_splitten.html
UebergeordnerterOrdnerPfadErmitteln = Left(strPfad, InStr(1, StrReverse(strPfad), "\") + 1)
End Function

Public Sub AlleDateienLoeschen(Ordnerpfad As String, _
Optional UnterordnerLoeschen As Boolean, Optional UeberordnerLoeschen As Boolean) 'Quelle: https://dbwiki.net/wiki/VBA_Tipp:_Alle_Dateien_und_Unterverzeichnisse_in_einem_Verzeichnis_l%C3%B6schen
' Ordnerpfad:           Pfad zum Verzeichnis, in dem die Dateien gelöscht werden sollen
' UnterordnerLoeschen:  Wenn True, werden zusätzlich auch alle Unterverzeichnisse gelöscht
' UeberordnerLoeschen:  Wenn True, werden zusätzlich auch alle Überverzeichnisse gelöscht
' Late Binding, kein Verweis auf "Microsoft Scripting Runtime" notwendig
' Quelle: www.dbwiki.net oder www.dbwiki.de
Dim strDir    As String
Dim fso       As Object   'Scripting.FileSystemObject
Dim geloescht As Boolean
Dim strUeberOrdnerPfad As String
Dim strUeberordnerZuLoeschen As String
strUeberOrdnerPfad = modLoeschenAlterSicherunge.UebergeordnerterOrdnerPfadErmitteln( _
Ordnerpfad)
strUeberordnerZuLoeschen = modLoeschenAlterSicherunge.NameOrdnerImZielErmitteln(Ordnerpfad)
' Backslash am Ende des Pfads hinzufügen, falls er fehlt
If Right$(Ordnerpfad, 1)  "\" Then
Ordnerpfad = Ordnerpfad & "\"
End If
' Objektvariable mit FileSystemObject erstellen
Set fso = CreateObject("Scripting.FileSystemObject")
' Erste Datei oder Unterordner im Überordner suchen
strDir = Dir(strUeberOrdnerPfad, vbNormal Or vbDirectory)
' Wenn mindestens eine Überordner existiert, alle Dateien löschen
If strDir  vbNullString Then
' Schleife beginnen.
Do Until strDir = vbNullString
' wenn die Überordner auch gelöscht werden sollen
If UeberordnerLoeschen Then
' Mit bit-weisem Vergleich sicherstellen, dass strDir ein Verzeichnis ist.
If (GetAttr(strUeberOrdnerPfad & strDir) And vbDirectory) = vbDirectory Then
' Überordner mit oder ohne Inhalt löschen, auch schreibgeschützte (außer .  _
und ..)
If strDir  "." And strDir  ".." And strDir = strUeberordnerZuLoeschen  _
Then
fso.DeleteFolder strUeberOrdnerPfad & strDir, True
geloescht = True
End If
End If
' Nächsten Eintrag abrufen
strDir = Dir
Else
'*****Ursprünglicher Programmcode*******
' Erste Datei oder Unterordner im Ordner suchen
strDir = Dir(Ordnerpfad, vbNormal Or vbDirectory)
' Wenn mindestens eine Datei existiert, alle Dateien löschen
If strDir  vbNullString Then
' Schleife beginnen.
Do Until strDir = vbNullString
' Initialisierung
geloescht = False
' wenn die Unterordner auch gelöscht werden sollen
If UnterordnerLoeschen Then
' Mit bit-weisem Vergleich sicherstellen, dass strDir ein  _
Verzeichnis ist.
If (GetAttr(Ordnerpfad & strDir) And vbDirectory) = vbDirectory  _
Then
' Ordner mit oder ohne Inhalt löschen, auch schreibgeschützte  _
(außer . und ..)
If strDir  "." And strDir  ".." Then
fso.DeleteFolder Ordnerpfad & strDir, True
geloescht = True
End If
End If
End If
' Wenn vorher kein Verzeichnis gelöscht wurde
If geloescht = False Then
' Mit bit-weisem Vergleich sicherstellen, dass strDir kein  _
Verzeichnis ist.
If (GetAttr(Ordnerpfad & strDir) And vbDirectory)  vbDirectory  _
Then
' Datei löschen, auch schreibgeschützte
fso.DeleteFile Ordnerpfad & strDir, True
End If
End If
' Nächsten Eintrag abrufen
strDir = Dir
Loop
End If
'*****Ursprünglicher Programmcode*******
End If
Loop
End If
Set fso = Nothing
End Sub

Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige