Liste mit Bildnamen vergleichen und Bilder löschen

Hallo zusammen
Wie kann man über ein Makro eine Liste mit Bildnamen mit den vorhandenen Bildern vergleichen und die Bilder löschen, deren Namen nicht auf der Liste stehen?
Ausgangslage:
Ich habe ein Tabellenblatt namens "Oktober". In den Spalten AD und AE ab Zeile zwei stehen die Bildnamen.
In AD2 1234567890-big.jpg, in AD3 9876-big.jpg usw. bis Zeile 2500
In AE2 1234567890-small.jpg, in AE3 9876-small.jpg usw. bis Zeile 2500
Die Bildnamen (immer eine Nummer) können unterschiedlich lang sein, werden aber immer gefolgt vom Bindestrich und "big.jpg" bzw. "small.jpg".
Die Bilder der Spalte AD liegen im Ordner E:\Bilder\Gross
Die Bilder der Spalte AE liegen im Ordner E:\Bilder\Klein
In dem Tabellenblatt werden häufig Namen gelöscht, immer [Bildnummer]-big.jpg und [Bildnummer]-small.jpg zusammen und somit sollten die entsprechenden Bilder auch gelöscht werden (nicht sofort, ein Makro das man z.B. einmal am Tag aufrufen kann wäre super).
Weiss jemand Rat?
Vielen Dank für Eure Hilfe und schöne Grüsse
Patrick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Bilder_loeschen() 'Die Bildnamen müssen in einer Tabelle mit Namen "Bilder" in Spalte A stehen. 'Bildnamen ohne Pfadangabe, z.B. Test.jpg _ Wenn die Bildnamen mit komplettem Pfad angegeben sind, einfach die Zuweisung _ der Variablen strName ändern: strName=.FoundFiles(i) 'Diese Datei muss im gleichen Ordner wie die Bilder stehen. 'Unterordner werden nicht durchsucht. Dim wshBilder As Worksheet, _ strOrdner As String, _ strName As String, _ FS As FileSearch, _ i As Integer, _ n As Integer, _ bolGebraucht As Boolean Application.ScreenUpdating = False Set wshBilder = Worksheets("Bilder") 'Tabelle mit Bildnamen strOrdner = ThisWorkbook.Path Set FS = Application.FileSearch 'Dateien suchen With FS .LookIn = strOrdner .Filename = "*.jpg" 'Dateityp jpg .SearchSubFolders = False 'keine Unterordner durchsuchen If .Execute > 0 Then For i = 1 To .FoundFiles.Count bolGebraucht = False strName = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strOrdner) - 1) 'gefundene Datei mit Liste vergleichen For n = 1 To wshBilder.Range("A65536").End(xlUp).Row If UCase(wshBilder.Cells(n, 1)) = UCase(strName) Then bolGebraucht = True 'Datei steht in Liste Exit For End If Next n 'Wenn Datei nicht in Liste, dann löschen If bolGebraucht = False Then Kill .FoundFiles(i) End If Next i End If End With Application.ScreenUpdating = True End Sub

Hi Patrick,
Datei: https://www.herber.de/bbs/user/27531.xls
Code darin:
-------------------------------
Option Explicit
Dim wshBilder As Worksheet


Sub Bilder_loeschen()
'Die Bildnamen müssen in einer Tabelle mit Namen "Bilder" in Spalte A stehen.
'Bildnamen ohne Pfadangabe, z.B. Test.jpg _
Wenn die Bildnamen mit komplettem Pfad angegeben sind, einfach die Zuweisung _
der Variablen strName ändern: strName=.FoundFiles(i)
'Unterordner werden nicht durchsucht.
Application.ScreenUpdating = False
Set wshBilder = Worksheets("Oktober") 'Tabelle mit Bildnamen
Call BilderInPfadLoeschen("W:\Bilder\Gross", "AD") 'Pfad und entsprechende  Tabellenspalte
Call BilderInPfadLoeschen("W:\Bilder\Klein", "AE") 'Pfad und entsprechende  Tabellenspalte
Application.ScreenUpdating = True
End Sub


Sub BilderInPfadLoeschen(strOrdner As String, strTableColumn As String)
Dim FS As FileSearch, _
strName As String, _
i As Integer, _
n As Integer, _
col As Long, _
bolGebraucht As Boolean
Set FS = Application.FileSearch
'Dateien suchen
With FS
.LookIn = strOrdner
.Filename = "*.jpg" 'Dateityp jpg
.SearchSubFolders = False 'keine Unterordner durchsuchen
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
bolGebraucht = False
strName = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strOrdner) - 1)
' spaltennummer ermitteln ( Kosmetik, Code m.E. leichter zu lesen )
col = wshBilder.Range(strTableColumn & "65536").Column
'gefundene Datei mit Liste vergleichen
For n = 1 To wshBilder.Range(strTableColumn & "65536").End(xlUp).Row
If UCase(wshBilder.Cells(n, col)) = UCase(strName) Then
bolGebraucht = True 'Datei steht in Liste
Exit For
End If
Next n
'Wenn Datei nicht in Liste, dann löschen
If bolGebraucht = False Then
Kill .FoundFiles(i)
End If
Next i
End If
End With
End Sub

----------------------------------
ACHTUNG: Pfade in den beiden Call-Zeilen noch ändern von G:\... auf E:\...
Gruß
gordon

Beliebteste Forumthreads (12 Monate)

Liste mit Bildnamen vergleichen und Bilder löschen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Liste mit Bildnamen vergleichen und Bilder löschen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread