Makro Bilder_loeschen funkt nicht mehr ?
30.11.2005 10:50:19
Martin
Ich hatte vor einiger Zeit diesen Code bekommen.
Der soll eigentlich alle bilder löschen die nicht
in der Liste (Tabelle "bilder") stehen.
Die bilder sind in dem selben Ordner wie die Arbeitsmappe.
Kann es auch sein das es mit Excel 2003 nicht funkt?
Es werden immer alle Dateien mit der entsprechenden Endung
gelöscht, auch welche die in der Liste drin sind und nicht gelöscht
werden sollten. Kann es auch etwas mit schreibweise/format der
Liste usw zu tun haben? Vielen dank für eure Hilfe!
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 = "*.bmp" '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