Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1568to1572
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
Dateien löschen die in Excel-Liste unsichtbar
28.07.2017 13:16:26
Dominik
Hallo an alle,
ich habe gerade ein kleines Problem bzgl. eines VBA-Codes den ich geschrieben habe.
Es geht konkret darum:
Ich möchte aus einem Ordner alle Dateien löschen die nach der Filterung in Excel nicht mehr sichtbar sind. Dies habe ich soweit auch schon hinbekommen. Mein Problem sind nun aber noch fehlerhafte Anwendungen die ich abfangen möchte. Mein Code funktioniert nur Zuverlässung wenn der Inhalt des Ordner vor dem Löschen gleich der ungefilterten Excel-Liste ist.
Wenn vorher mehrere Dateien im Ordner waren, dann bleiben diese nach dem Durchlaufen des Codes ebenfalls enthalten. Dies ist aber nicht zulässig
Ich habe hierzu auch schon einen Beitrag gefunden siehe:
Beitrag: https://www.herber.de/forum/archiv/708to712/710729_Dateien_anhand_Liste_loeschen.html
Nur leider habe ich hier das Problem, dass dieser sehr alt ist und seit Excel 2007 der Code nicht mehr funktioniert.
Gibt es eine Möglichkeit wie ich dies in neueren Excel-Versionen umsetzen kann.
Ich würde mich freuen wenn mir jemand weiterhelfen könnte.
Die Aufgabe nochmals zusammengefasst:
1.) Alle .txt-Dateien die nicht in der Liste sichtbar sind sollen gelöscht werden.
2.) Es soll überprüft werden, ob nach dem löschen alle .txt-Dateien die durch die Filterung sichtbar sind auch im Ordner liegen. Es könnte ja sein, das eine Datei zu wenig im Ordner gelegen ist.
Ich habe ein Beispiel und die benötigten .txt-Dateien unter dem Link hochgeladen, sodass ihr das selbst ausprobieren könnt. Sprache bitte per Dropdown (DE_US auswählen).
Link (mit Dateien): https://www.herber.de/bbs/user/115106.zip
Bisher verwendete Codes
Code 1:
Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim Nummer As String
Dim i As Integer
Speicherort = Tabelle1.Range("B3").Value           'Speicherort aus Excel-Blatt
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
i = 10                                             'in Zeile 10 beginnen
If Next2 = 0 Then
Do                                                                                       _
'Beginnende Schleife
If Not Tabelle1.Range("D" & i).Offset(0, 0) = "" Then                                _
'Prüfen ob Zelle leer ist
If Not Tabelle1.Rows(i).Hidden = False Then                                      _
'Prüfen ob Zeile unsichtbar oder durch Autofilter ausgeblendet
Nummer = Tabelle1.Range("D" & i).Value                                       _
'Nummer aus Zelle
Call Loeschen_nicht_benoetigtes_Dateien(Nummer, Sprache, Speicherort)    _
'Aufrufen Code zum Schild aus Ordner löschen
End If
Else
Exit Do                                                                          _
' Abbruch der Schleife/ Schleife verlassen
End If
i = i + 1                                                                                _
'Zeile hochzählen um alle Zeilen zu durchlaufen bis leere Zelle kommt
Loop
Else
Exit Sub
End If
End Sub
Code 2:
Sub Loeschen_nicht_benoetigtes_Dateien(Nummer, Sprache, Speicherort)
Dim i2 As Integer
Dim i3 As String
Dim Pfad As String
Pfad = Speicherort + "\"
' Löschen der Schilder
If Dir(Pfad + Nummer + Sprache + ".txt")  "" Then                             'Prüfen ob  _
Datei bereits vorhanden
i2 = 1
Do
i3 = CStr(i2)
If Dir(Pfad + Nummer + Sprache + "(" + i3 + ")" + ".txt")  "" Then        'Suchen der  _
obersten/letzten Datei die noch vorhanden ist
i2 = i2 + 1
Else
i2 = i2 - 1
If i2 = 0 Then
Kill Pfad + Nummer + Sprache + ".txt"                               'Löschen  _
der untersten/ersten Datei falls dieses Schild überhaupt nicht benötigt
Exit Do
Else
i3 = CStr(i2)
Kill Pfad + Nummer + Sprache + "(" + i3 + ")" + ".txt"              'Löschen  _
der obersten/letzten Datei die noch vorhanden ist
Exit Do
End If
End If
Loop
Else
MsgBox ("Excel-Liste stimmt nicht mit Komplettsatz überein. Fehler bei Datei (" +  _
Nummer + Sprache + ") aufgedrehten. Datei konnte in Ordner nicht gelöscht werden, da die Datei nicht vorhanden war. Bitte die Excel-Liste überprüfen. Anschließend Ordner leeren und den kompletten Dateisatz nochmals importieren.")
End If
End Sub

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
28.07.2017 16:36:09
Matthias
Hallo! Ist noch kein Code aber ein Tip. Du müsstest den Code anders herum aufbauen. Bei dir gehst du die Liste im Excel durch und löschst. In deinem Fall sollte man die Dateien durchgehen und schauen, ob sie noch in einer sichtbaren Zeile sind. Wenn nicht löschen. Vllt. kann ja jemand damit schon was basteln. Ansonsten würde ich es später mal probieren. VG
AW: Dateien löschen die in Excel-Liste unsichtbar
28.07.2017 20:20:59
Matthias
Moin! Da bin ich wieder. Also hier mal eine Variante. Bitte an einer Testumgebung probieren und nicht an den echten Daten. Der Code geht erst die Excelliste durch. von sichtbaren Zeilen wird der Dateiname gespeichert (dabei ist keine Plausibilitätsprüfung dabei - könte noch ergänzt werden). Dann wird im Speicherort jede Datei durchgegangen. Wurde sie vorher gemerkt, darf sie leben bleiben sonst wird sie gekillt. Es werden alle anderen Dateien gelöscht - könnte man noch auf .txt einschränken. VG

Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & ".txt", _
ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then Kill Speicherort & "\" & datei.Name
Next datei
Set liste = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
28.07.2017 22:31:13
Dominik
Hallo Matthias,
das sieht schon sehr gut aus. Ich bekomme aber eine Fehlermeldung. Nach der While-Schleife erhalte ich die Fehlermeldungmeldung: "Dieser Schlüssel ist bereits einem Element dieser Auflistung zugeordnet."
1.) Für was ist eigentlich die Zeile:
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
?
2.) Ist der Abschnitt
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
die Überprüfung ob alle benötigten "Dateien" auch wirklich im Ordner sind und keine Datei zuvor gelöscht wurde?
3.) Was mir generell noch auffällt ist, dass der Lösch-Algorythmus fehlt. Im Ordner liegen z. B. oft auch mehrer Dateien mit der selben Nummer dem selben Länderkürzel. Der Unterschied bestehet nur in der Endung. Hier wird in Klammer eine Zahl eingetragen.
Beispiel 1001DE_US(1).txt
Es ist möglich, das z. B. die Dateien 1090DE_US.txt und 1090DE_US(1).txt benötigt werden (in Liste zweimal 1090). Die dritte Datei soll aber gelöscht werden (1090DE_US(2).txt). Wie bekomm ich noch die Einsschränkung auf .txt-Dateien hin?
Danke dir schonmal Matthias. Ich wünsche dir ein schönes Wochenende.
Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
28.07.2017 23:12:27
Matthias
Moin!
Also hier eine geänderte Version. Die sollte deine Wünsche mit berücksichtigen. Nun noch zu deinen Fragen:
1.) Die Zeile nimmt den letzten \ vom Pfad weg. Da man ja nie weiß, was der Nutzer dort so eingibt, kanne s ja auch sein, dass er denkt, bin ich mal nett und schreibe den Pfad schon mit \ am Ende. Dann würde der Code aber später einen Fehler produzieren. Deshalb nehme ich das Zeichen weg. Da weiß ich, immer in welchem Status der PFad ist. Das Zeichen wird auch nur weggenommen, wenn es da ist.
2.) Nein. Der Teil prüft nur, ob der eingetragene Pfad auch wirklich existiert. Falls der fehlerhaft ist, würde ja das Lsöchen bzw. die Dateiprüfung nicht geschehen bzw einen Fehler aufwerfen.
Hinweis: Eine Überprüfung, ob Dateien fehlen ist nicht im Code enthalten. Das müsste bei Bedarf noch ergänzt werden. Der Code erstellt nur die bestehenden Dateinamen und löscht alle Namen ungleich dieser raus.
3.) Der Löschalgorythmus ist da. :-) Der besteht bei mir aber nur aus den 3 Zeilen hier:
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then Kill Speicherort & "\" & datei.Name
Next datei
Im ersten Teil des Codes werden die Namen aus dem Blatt in einem Speicher (das object liste) zwischengespeichert. Mit den 3 Zeilen prüfe ich nun, ob der Name der Dateien aus dem Speicherpfad in der Liste vorkommen. Wenn nicht, kann die Datei gelöscht werde. Das macht dann der kill Teil nach dem then.
Soweit zu den Fragen. Habe jetzt mal ergänzt, dass die Fehlermeldung nicht mehr kommen sollte. Dafür wird bei einem mehrfachen Vorkommen jetzt auch eine Datei mit der Erweiterung (zahl) aufgenommen. Heißt also, bei 3 gleichen Zahlen in der Datei sind die Dateinamem datei.txt, datei(1).txt und datei(2).txt zulässig. Alle anderen Dateien mit anderen Nummern werden gelöscht bspw datei(4).txt oder datei(9).txt.
Wie vorhin auch, bitte mal testen (an einer Mustermappe). Sollte jetzt aber hinhauen. Bei Fragen oder Wünschen einfach nochmal melden. VG

Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Dim wert As String
Dim index As Long
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
wert = ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
If liste.exists(wert) Then
index = 1
While liste.exists(ActiveSheet.Cells(zeile, 4) & Sprache & "(" & index & ")" & ". _
txt")
index = index + 1
Wend
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & "(" & index & ")" & ".txt", 1
Else
liste.Add wert, 1
End If
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then Kill Speicherort & "\" & datei.Name
Next datei
Set liste = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
29.07.2017 09:23:55
Matthias
Moin! Hier mal noch ein Ergänzung. Die Dateien mit der gleichen Nummer sind dann immer fortlaufend? Also die Zahl in der Klammer beginnt immer bei 1 und ist fortlaufend? Zb datei.txt, datei(1).txt, datei(2).txt usw. . DAvon geheich im Code aus. Es sollte also nicht vorkommen dürfen, dass bspw. die 1 fehlte und es mit 2 losgeht. Passt das? AUßerdem sollten die mit dr höchsten Nummer gelöscht werden! Das sind mE aber die zuletzt gespeicherten Dateien, in denen evtl. der neuste Stand drin ist. Sollen die dann wirklich raus? Das waren nur so Ideen, die mir noch eingefallen sind. VG
AW: Dateien löschen die in Excel-Liste unsichtbar
29.07.2017 14:56:57
Dominik
Hallo Matthias,
1.) die Zahlen sind immer Fortlaufend beginnend mit 1. Problem ist aber, dass bei Mehrfachverwendung die erste Datei komplett ohne Klammer ist. Die zweite Datei heißt dann 1XXX(1).txt, die dritte Datei 1XXX(2).txt. Die vierte Datei 1XXX(3).txt und so weiter. Dies kann ich leider auch nicht ändern, da der Datensatz durch ein externes Programm in den Ordner gelegt wird und mir eben so gegeben wird.
2.) Falls im Ordner die Dateien
1090.txt
1090(1).txt
1090(2).txt
liegen und ich nur zwei benötige, dann soll die mit dem höchsten Index gelöscht werden. Sodass anschließend nur noch die Dateien
1090.txt
1090(1).txt
im Ordner sind. Es sollen also immer die mit dem höchsten Index zuerst gelöscht werden.
3.) Mit welcher Funktion kann ich prüfen ob ein bestimmter Pfad vorhanden ist (Datei vorhanden)? Damit könnte ich dann ja eine Schleife bauen, die im anschluss Prüft ob alle sichtbaren Nummern auch im Ordner sind und der Benutzer nicht bereits ein versehendlich gelöscht hat.
Danke dir. Ich werde deinen Code gleich morgen in meinem Testordner testen.
Gruß
Dominik
Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
29.07.2017 21:46:41
Matthias
Moin! Ok, dann sollte der Code eigentlich so wie gewünscht laufen. Da mit der ersten ohne (Zahl) ist schon mit drin.
Hier nochmal eine Ergänzung. Am Ende wird die Anzahl der Dateien im Speicherort mit der Anzahl aus dem Tabellenblatt verglichen. Wenn du einen gezielten Vergleich haben willst (um zu sehen, welche genau fehlt), einfach nochmal melden. VG

Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & ".txt", _
ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then Kill Speicherort & "\" & datei.Name
Next datei
'jetzt suchen ob es passt
If fso.GetFolder(Speicherort).Files.Count 

Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 09:29:14
Dominik
Guten Morgen Matthias,
also folgendes noch.
Der komplette Code lautet nun
Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
wert = ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
If liste.exists(wert) Then
Index = 1
While liste.exists(ActiveSheet.Cells(zeile, 4) & Sprache & "(" & Index & ")" & " _
.txt")
Index = Index + 1
Wend
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & "(" & Index & ")" & ".txt", 1
Else
liste.Add wert, 1
End If
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then Kill Speicherort & "\" & datei.Name
Next datei
'jetzt suchen ob es passt
If fso.GetFolder(Speicherort).Files.Count 
Du hattest beim Einfügen des Teils mit der ('jetzt suchen ob es passt) vergessen den Index-Teil mit aufzunehmen.
1.) Wie bekomme ich noch die Überprüfung des genauen Dateinames? Es wäre auch schön wenn alle Dateien nach der Löschung in einer Messagebox ausgegeben werden.
2.) Ich hätte die Löschung noch gern beschränkt auf .txt-Dateien und .xlsm-Dateien. Die Löschung muss ich auf mehrere Dateiformate beschränken. Alle weiteren Dateien sollen im Ordner bleiben können.
3.) Kannst du mir erklären wie das mit der Variablen "datei" ist. Diese hast du als Objekt definiert. Kannst du mir sagen wo ich am besten nachlesen kann welche Eigenschaften/Methoden dieser Dateityp hat.
Danke dir schon jetzt Matthias, meine VBA-Kenntnisse sind noch sehr eingeschränkt und ich lerne gern was hinzu.
Ich wünsche dir noch einen schönen Sonntag.
Gruß
Dominik
Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 10:15:48
Matthias
Moin! Hatte vorhin nicht aktualisiert. Gibt deshalb schon einen neuen Beitrag dazu, diesmal auch wieder mit index :-). Willst du die gelöschten oder die fehlenden aufgelistet haben. Die fehlenden werden schon angezeigt. Schicke gleich mal eine nochmal geänderte Fassung.
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 10:50:21
Matthias
Moin! Also hier nochmal der neue Code. Der Index ist wieder mit drin. Gelöscht werden nur Dateien mit den Enden txt oder xlsm. Alle anderen Dateien bleiben bestehen. Das kannst du analog der beiden ggf. auch noch anpassen.
Am Ende werden die gelöschten Dateien und die fehlenden Dateien in je einer Messagebox ausgegeben - so etwas gelöscht wurde oder fehlt.
Was meinst du mit "genauer Überprüfung des Dateinamens"?
Zur Datei. Da habe ich die Eigenschaft object genommen. In fso.GetFolder(Speicherort).Files sind alle Dateien gelistet. Das sind vereinfacht gesagt, alles Objecte mit Eigenschaften und Methoden. Diese werden in der Schleife nach einandern an Datei übergeben. Auf die kannst du dann zugreifen. Dazu muss aber die Variable die richtige Deklaration haben. Da gibt es eigentlich nur object oder variant. Hier noch 2 Links zum File Object. Da siehst du noch welche Eigenschaften bzw. Methoden es da gibt.
https://msdn.microsoft.com/en-us/library/aa242698(v=vs.60).aspx
http://www.vbarchiv.net/workshop/workshop_45-fso-arbeiten-mit-dateien-und-ordner-teil-2.html
Soweit erstmal. Wenn noch Fragen sind, einfach melden. Hier erstmal der neue Code. Ist jetzt auch an deiner Umgebung getestet. VG

Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim gelöscht As Object
Dim fso As Object
Dim datei As Object
Dim wert As String
Dim index As Long
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set gelöscht = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
wert = ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
If liste.exists(wert) Then
index = 1
While liste.exists(ActiveSheet.Cells(zeile, 4) & Sprache _
& "(" & index & ")" & ".txt")
index = index + 1
Wend
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & "(" & index & ")" & ".txt", 1
Else
liste.Add wert, 1
End If
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then
If Right(datei.Name, 4) = ".txt" Or Right(datei.Name, 4) = "xlsm" Then
gelöscht.Add datei.Name, 1
Kill Speicherort & "\" & datei.Name
End If
Else
liste.Remove datei.Name
End If
Next datei
'jetzt suchen ob es passt
If liste.Count > 0 Then
MsgBox "Es liegen nicht alle Dateien im Ordner!" & vbCrLf & "Folgende Dateien fehlen:" _
& Chr(10) & Join(liste.Keys, vbCrLf), , "zu wenig Dateien"
End If
If gelöscht.Count > 0 Then
MsgBox "Einige Dateien wurden gelöscht!" & vbCrLf & "Es handelt sich um folgende Dateien:"  _
_
& Chr(10) & Join(gelöscht.Keys, vbCrLf), , "gelöschte Dateien"
End If
Set liste = Nothing
Set gelöscht = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 18:19:25
Dominik
Hallo Matthias,
ich bin es noch einmal. Vielen Dank für die Hilfe. Anbei der von mir geänderte Code der nun alles was ich brauche beinhaltet. Du hast bei letzten Code vergessen die Abfrage bzgl. des Datei-Typs mitzunehmen. Sonst ist alle nach meinen Wünschen umgesetzt und danke für die Links.
Ich wünsche dir einen schönen Restsonntag.
Gruß
Dominik
Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Dim wert As String
Dim index As Long
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
wert = ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
If liste.exists(wert) Then
index = 1
While liste.exists(ActiveSheet.Cells(zeile, 4) & Sprache _
& "(" & index & ")" & ".txt")
index = index + 1
Wend
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & "(" & index & ")" & ".txt", 1
Else
liste.Add wert, 1
End If
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then
If Right(datei.Name, 4) = ".txt" Or Right(datei.Name, 4) = "xlsm" Then
Kill Speicherort & "\" & datei.Name
End If
Else
liste.Remove datei.Name
End If
Next datei
'jetzt suchen ob es passt
If liste.Count  0 Then
MsgBox "Es liegen nicht alle Dateien im Ordner!" & vbCrLf & "Folgende Dateien fehlen:" _
& Chr(10) & Join(liste.Keys, vbCrLf), , "zu wenig Dateien"
End If
Set liste = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 18:26:42
Matthias
Hallo! Ähm die Überprüfung ist doch drin. HIer mit der Zeile
If Right(datei.Name, 4) = ".txt" Or Right(datei.Name, 4) = "xlsm" Then
wird geschaut, ob der Dateiname auf txt oder xlsm endet. Wenn ja werden die Dateien ggf. gelöscht, wenn nein passiert mit den Dateien nichts.
Da das auch drin ist, würde ich jetzt erstmal keinen neuen Code posten - verwirrt sonst nur. :-) Wenn doch noch Fragen sind, einfach stellen. Da ich ab Dienstag erstmal unterwegs bin und am SO wieder komme, ggf. einen neuen Post eröffnen. Bin da mal ohne Internet.
Dir auch noch einen schönen Sonntag. VG
Anzeige
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 18:31:45
Dominik
Hallo Matthias,
sorry ich habe erst nach dem Post gesehen, dass der Code mit dieser Abfrage zeitmäßig nach dem anderen gekommen ist. Somit war wirklich alles schon in Ordnung. Wie kann ich das Thema abschließen und deinen letzten Post als Lösung markieren?
Gruß
Dominik
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 18:39:35
Matthias
Moin! Das geht hier nicht. WEnn du den Thread nicht als offen markierst, wird er als gelöst angesehen. VG
AW: Dateien löschen die in Excel-Liste unsichtbar
30.07.2017 10:05:18
Matthias
Moin! Hatte nochmal geschaut und dabei ist mir aufgefallen, dass ich beim letzten Beitrag den falschen Code erwischt hatte. Hier nun der richtige Code. Habe ihn dahingehend abgewandelt, dass zum Ende gleich noch angezeigt wird, ob eine Datei fehlt (es kommt dann eine Messagebox mit der Auflistung). Erspart dir die Schleife. Falls doch noch was fehlt, einfach melden.
VG

Sub Dateiensatz_reduzieren()
Dim Speicherort As String
Dim Sprache As String
Dim zeile As Integer
Dim liste As Object
Dim fso As Object
Dim datei As Object
Dim wert As String
Dim index As Long
Application.ScreenUpdating = False
Speicherort = Tabelle1.Range("B3").Value 'Speicherort aus Excel-Blatt
If Right(Speicherort, 1) = "\" Then Speicherort = Left(Speicherort, Len(Speicherort) - 1)
Sprache = Tabelle1.Range("B1").Value               'Sprache aus Excel-Blatt
zeile = 10
Set liste = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
'alle sichtbaren Dokumente aufnehmen
While ActiveSheet.Cells(zeile, 4)  ""
If Tabelle1.Rows(zeile).Hidden = False Then
wert = ActiveSheet.Cells(zeile, 4) & Sprache & ".txt"
If liste.exists(wert) Then
index = 1
While liste.exists(ActiveSheet.Cells(zeile, 4) & Sprache _
& "(" & index & ")" & ".txt")
index = index + 1
Wend
liste.Add ActiveSheet.Cells(zeile, 4) & Sprache & "(" & index & ")" & ".txt", 1
Else
liste.Add wert, 1
End If
End If
zeile = zeile + 1
Wend
'löschen
If Not fso.FolderExists(Speicherort) Then
MsgBox "Den Pfad gibt es nicht! Programmende", , "Fehler"
Exit Sub
End If
For Each datei In fso.GetFolder(Speicherort).Files
If Not liste.exists(datei.Name) Then
Kill Speicherort & "\" & datei.Name
Else
liste.Remove datei.Name
End If
Next datei
'jetzt suchen ob es passt
If liste.Count  0 Then
MsgBox "Es liegen nicht alle Dateien im Ordner!" & vbCrLf & "Folgende Dateien fehlen:" _
& Chr(10) & Join(liste.Keys, vbCrLf), , "zu wenig Dateien"
End If
Set liste = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige