hier wäre jetzt mein Ansatz komplett. den ersten Teil hab ich noch leicht optimiert, für das Verschieben hab ich 3 weitere Zeilen verwendet. Als Grafikformat hab ich hier jpg, wie gesagt, wenn's einheitlich ein Format ist passt das, ansonsten müsste man noch etwas anders vorgehen.
Code:
Sub DirVergleich() 'Variablendeklarationen Dim colFiles As New Collection Dim objFSO As Object, objPath As Object Dim objFiles As Object, objFile As Object 'Objekte instanzieren 'FSO Set objFSO = CreateObject("scripting.FileSystemObject") 'Dateipfad Set objPath = objFSO.GetFolder("C:\Test\A") 'Dateien im Pfad Set objFiles = objPath.Files 'Bei Fehler weiter On Error Resume Next 'Schleife ueber alle Dateien For Each objFile In objFiles 'Datei der Collection hinzufuegen, Key fuer indirekte Pruefung auf Eindeutigkeit colFiles.Add objFSO.getbaseName(objFile.Path), objFSO.getbaseName(objFile.Path) 'Bei Fehler (wenn der Key schon vorhanden ist), dann Eintrag loeschen If Err Then colFiles.Remove objFSO.getbaseName(objFile.Path) Err.Clear 'Ende Schleife ueber alle Dateien Next objFile 'Fehlerbehandlung aufheben On Error GoTo 0 'Hier kaeme jetzt verschieben 'Variablendeklaration - kann auch nach oben ... Dim iCnt% 'Schleife ueber alle Collection-Eintraege For iCnt = 1 To colFiles.Count 'Date verschieben objFSO.MoveFile "C:\Test\A\" & colFiles.Item(iCnt) & ".jpg", "C:\Test\B\" '& colfiles.Item(i) & ".jpg" 'Ende Schleife ueber alle Collection-Eintraege Next End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
15.06.2020, 13:38 (Dieser Beitrag wurde zuletzt bearbeitet: 15.06.2020, 13:38 von alex.saleen.)
Hallo alle zusammen! Vielen Dank erst einmal für eure Beiträge ihr habt mir sehr weiter geholfen, da ich so auch mal was in die codes rein komme Besonders die codes von Ralf und schauan scheinen gut zu funktionieren nur hänge ich dort ein wenig fest... Beim Code von Ralf (siehe Bild 1) spuckt mir Excel die Fehlermeldung "Fehler beim Kompilieren: Ungültiger Bezeichner" aus. (Sorry wenn das ein grober Fehler meinerseits ist, ich bin noch sehr unerfahren was Codes und Makros angeht...). Bei dem Code von Schauan werden anscheinend einige Dateien nicht gefunden, was ich darauf zurückführen konnte, dass wohl ein Großteil der Dateien (habe ich leider zu spät bemerkt) als JPEG's und nicht als JPG's vorliegen... Ich schaue mal ob ich das ändern kann. Vielen Dank für eure Hilfe :)
18.06.2020, 12:06 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2020, 12:10 von alex.saleen.)
Hallo nochmal Die Erweiterung habe ich jetzt angehängt aber jetzt überträgt der Code gar keine Dateien mehr :/ Komischerweise bleibt der Code beim Errorhandler hängen... Jetzt weiß ich nicht ob das am Code oder an den Dateien liegt.. Weißt du woran das liegen könnte? Ich hänge mal ein Bild an. MfG Alex
18.06.2020, 13:33 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2020, 13:33 von alex.saleen.)
Hallo Erstmal vielen Dank für deine Hilfe der Code funktioniert jetzt zumindest (auf das "\" hätte ich eigentlich selber kommen müssen haha) Allerdings werden jetzt einfach alle Bilder bewegt auch die, die in der Exceldatei stehen MfG Alex
Zitat:Allerdings werden jetzt einfach alle Bilder bewegt auch die, die in der Exceldatei stehen
was in der Exceldatei drin ist, prüfte mein code nicht. Ich hatte die Aufgabe am Anfang falsch gelesen und so interpretiert, dass Du zu jedem Bild jeweils eine Exceldatei hast, die so heißt wie das Bild
Hier mal eine Variante, die die Dateien anhand der Bilder des aktiven Blattes vergleicht. Erst werden alle Bildnamen aufgenommen, dann die Dateinamen und wenn es eine Doppelung gibt, wird der Name aus der Collection gelöscht.
Code:
Sub DirVergleich() 'Variablendeklarationen Dim colFiles As New Collection Dim objFSO As Object, objPath As Object Dim objFiles As Object, objFile As Object Dim objShape As Shape 'Objekte instanzieren 'FSO Set objFSO = CreateObject("scripting.FileSystemObject") 'Dateipfad Set objPath = objFSO.GetFolder("C:\Test\A") 'Dateien im Pfad Set objFiles = objPath.Files ' 'Schleife ueber alle Shapes For Each objShape In ActiveSheet.Shapes 'Datei der Collection hinzufuegen, Key fuer indirekte Pruefung auf Eindeutigkeit colFiles.Add objShape.Name, objShape.Name 'Ende Schleife ueber alle Shapes Next 'Bei Fehler weiter On Error Resume Next 'Schleife ueber alle Dateien For Each objFile In objFiles 'Datei der Collection hinzufuegen, Key fuer indirekte Pruefung auf Eindeutigkeit colFiles.Add objFSO.getbaseName(objFile.Path), objFSO.getbaseName(objFile.Path) 'Bei Fehler (wenn der Key schon vorhanden ist), dann Eintrag loeschen If Err Then colFiles.Remove objFSO.getbaseName(objFile.Path) Err.Clear 'Ende Schleife ueber alle Dateien Next objFile 'Fehlerbehandlung aufheben On Error GoTo 0 'Hier kaeme jetzt verschieben 'Variablendeklaration - kann auch nach oben ... Dim iCnt% On Error GoTo Errorhandler 'Schleife ueber alle Collection-Eintraege For iCnt = 1 To colFiles.Count 'Date verschieben objFSO.MoveFile "C:\Test\A\" & colFiles.Item(iCnt) & ".jpg", "C:\Test\B\" '& colfiles.Item(i) & ".jpg" 'Ende Schleife ueber alle Collection-Eintraege Next Exit Sub Errorhandler: 'Date verschieben objFSO.MoveFile "C:\Test\A\" & colFiles.Item(iCnt) & ".jpeg", "C:\Test\B\" '& colfiles.Item(i) & ".jpeg" Resume Next End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Guten Morgen! Naja also das Thema ist doch noch etwas anders :/ Das ist aber auch schwer zu erklären :D Also Ich habe eine Exceldatei mit einer Spalte voller Artikelbezeichnungen also die liegen alle in einer Datei vor. Das sind so ca. 2700 Stück... Und passend dazu habe ich einen Ordner voller Bilder (3200 Stück) mit dem selben Namen wie er in der Excel Datei in Spalte xy steht. Jetzt ist da natürlich eine Differenz von 500 Bildern... Also 500 Bilder zu denen kein Name in der Spalte passt. Diese müssten aus der Datei gelöscht bzw. noch besser in einen anderen Ordner bewegt oder mit einem "x" gekennzeichnet werden. Also so wie du es gerade beschrieben hast bleiben ja alle Namen übrig die gelöscht oder bewegt werden müssten. Das wäre theoretisch kein Problem aber bevor ich jetzt 500 Bilder manuell raussuche und verschiebe wollte ich fragen, ob es eine elegantere und reproduzierbare Lösungsmöglichkeit gibt. Wäre super wenn du noch einen Lösungsansatz kennst aber so oder so hast du mir wirklich weitergeholfen und dafür danke ich dir schon mal :)
Hallöchen, Ich dachte Du meinst, dass die ca. 3000 Bilder in der Datei die gleichen Namen haben wie die Bilddateien. Hab mir schon Gedanken gemacht wie groß Deine Datei sein mag. Wenn Du die Dateinamen nur in einer Liste hast wird es noch einfacher. Bin aber im Moment nur am Smartphone. Stehen die Dateinamen inklusive Erweiterung drin?
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
