Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
648to652
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
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateien verschieben mit Excel

Dateien verschieben mit Excel
07.08.2005 18:50:59
Andreas
Hallo,
ich suche über Excel einen Weg, Dateien in mehrere Verzeichnis zu verschieben.
Folgende Ausgangssituation : Ich habe ein Verzeichnis mit dem Namen BILDER. Darin befindet sich ein Verzeichnis mit dem Namen NEU. In diesem Verzeichnis landen alle neuen Dateien mit der Dateiendung JPG.
Weiterhin befinden sich in dem Verzeichnis BILDER Verzeichnisse von A bis Z. Sieht dann so aus wie auf dem Screenshot:
Userbild
Nun möchte ich alle Dateien, die im Verzeichnis NEU sind und deren Name mit A (z.B. April.jpg, August.jpg) anfängt, in das Verzeichnis A verschieben, alle die mit B anfangen, in das Verzeichnis B (und so weiter).
In den Verzeichnissen A, B etc. können sich jedoch bereits Dateien mit dem gleichen Dateinamen befinden (also kann im Verzeichnis A bereits eine Datei mit dem Namen April.jpg vorhanden sein).
Ist bereits ein Datei mit gleichem Namen in dem Zielverzeichnis (z.B. Verzeichnis A) vorhanden, soll die Excelroutine prüfen, ob die vorhandene Datei größer ist als die Datei, die neu in das Verzeichnis verschoben werden soll.
Ist die vorhandene Datei GRÖßER als die neu hinzukommende, soll die vorhandene Datei beibehalten werden. Ist die neue Datei größer als die vorhandene Datei, soll die vorhandene Datei automatisch und ohne eine Abfrage überschrieben werden.
Sprich also, ich möchte, dass immer die größere Datei im Zielverzeichnis (z.B. A) ist.
Ist sowas mit Excel umsetzbar ? Und wenn ja, wie ?
Vielen Dank für jeden Tip. Vielleicht hat schon jemand so ein Makro und kann mir den Makrotext hier zur Verfügung stellen ?
Viele Grüße
Andreas Frauboes

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 19:57:46
Fred
Hi,
ja ist umsetzbar, glaube aber nicht, dass sich jemand die Arbeit macht.
mfg Fred
AW: Dateien verschieben mit Excel
07.08.2005 20:26:14
Matthias
Hallo Andreas,
hier schoon mal die erste Stufe, mal sehen, ob ich heute noch dazu komme, weiterzumachen.
Das aktive Blatt wird dazu gelöscht und erst einmal mit Informationen vollgeschrieben:

Sub test()
Dim path As String
Dim fn As String
Dim zeile As Long, i As Long
zeile = 1
Cells.ClearContents
Cells(1, 1) = "Name"
Cells(1, 2) = "Größe"
Cells(1, 3) = "Verz."
Cells(1, 4) = "Größe alt"
path = ThisWorkbook.path & "\Bilder\"c ' <<<<<<<<<<<<<<< b.B. anpassen!
'Dateinamen und -größe in Tabelle schreiben
fn = Dir(path & "Neu\*.jpg")
Do While fn <> ""
zeile = zeile + 1
Cells(zeile, 1) = fn
Cells(zeile, 2) = FileLen(path & "Neu\" & fn)
fn = Dir()
Loop
'nach gleichnamigen in Verzeichnissen suchen
For i = 2 To zeile
fn = path & Left(Cells(i, 1), 1) & "\" & Cells(i, 1)
Cells(i, 3) = path & Left(Cells(i, 1), 1) & "\"
If Dir(fn) = "" Then
Cells(i, 4) = "nicht da"
Else
Cells(i, 4) = FileLen(fn)
End If
Next i
End Sub

Jetzt muss die Liste nur noch ausgewertet werden.
Gruß Matthias
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 20:51:40
Matthias
Hallo Andreas,
so, müsste fertig sein... teste es aber erst mal mit Kopien! Da ist ein Kill--Befehl drin...

Sub Verschieben()
Dim path As String
Dim fn As String
Dim zeile As Long, i As Long
zeile = 1
Cells.ClearContents
Cells(1, 1) = "Name"
Cells(1, 2) = "Größe"
Cells(1, 3) = "Verz."
Cells(1, 4) = "Größe alt"
path = ThisWorkbook.path & "\Bilder\"
'Dateinamen und -größe in Tabelle schreiben
fn = Dir(path & "Neu\*.jpg")
Do While fn <> ""
zeile = zeile + 1
Cells(zeile, 1) = fn
Cells(zeile, 2) = FileLen(path & "Neu\" & fn)
fn = Dir()
Loop
'nach gleichnamigen in Verzeichnissen suchen
For i = 2 To zeile
fn = path & Left(Cells(i, 1), 1) & "\" & Cells(i, 1)
Cells(i, 3) = path & Left(Cells(i, 1), 1) & "\"
If Dir(fn) = "" Then
Cells(i, 4) = 0
Else
Cells(i, 4) = FileLen(fn)
End If
Next i
'Dateien verschieben
For i = 2 To zeile
If (Cells(i, 4) > Cells(i, 2)) Or Cells(i, 4) = 0 Then
If Cells(i, 4) > 0 Then Kill Cells(i, 3) & Cells(i, 1)
Name path & "NEU\" & Cells(i, 1) As Cells(i, 3) & Cells(i, 1)
Else
If Cells(i, 4) > 0 Then Cells(i, 5) = "nicht verschoben!"
End If
Next i
End Sub

Und jetzt Mensch-Ärgere-Dich-Nicht spielen, die Kinder nörgeln schon...
Gruß Matthias
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 21:31:45
Andreas
Hi Matthias,
danke für Deine megaschnelle Hilfe. Hoffentlich mußtest Du Deine Kinder aufgrund meiner Frage nicht beim "Mensch-Ärger-Dich-nicht" vernachlässigen ;-)
Ich habe Dein Makro so übernommen, es nimmt auch die Dateinamen und Dateigrößen in die Tabelle 1 richtig auf, nur danach passiert mit den vorhandenen Dateien nichts weiter. Größere und nicht vorhandene werden nicht aus dem Verzeichnis NEU verschoben. Könntest Du da evtl. nochmal nachschauen ? Ich würde es ja gerne selbst tun, aber so ganz steig ich da nicht durch ;-(
Danke nochmal für Deine Mühe und einen angenehmen Start in die Woche
Andreas Frauboes
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 21:45:32
Matthias
Hallo Andreas,
nimm mal diesen Code: ...

Sub Verschieben()
Dim path As String
Dim fn As String
Dim zeile As Long, i As Long
zeile = 1
Cells.ClearContents
Cells(1, 1) = "Name"
Cells(1, 2) = "Größe"
Cells(1, 3) = "Verz."
Cells(1, 4) = "Größe alt"
path = ThisWorkbook.path & "\Bilder\"
'Dateinamen und -größe in Tabelle schreiben
fn = Dir(path & "Neu\*.jpg")
Do While fn <> ""
zeile = zeile + 1
Cells(zeile, 1) = fn
Cells(zeile, 2) = FileLen(path & "Neu\" & fn)
fn = Dir()
Loop
'nach gleichnamigen in Verzeichnissen suchen
For i = 2 To zeile
fn = path & Left(Cells(i, 1), 1) & "\" & Cells(i, 1)
Cells(i, 3) = path & Left(Cells(i, 1), 1) & "\"
If Dir(fn) = "" Then
Cells(i, 4) = 0
Else
Cells(i, 4) = FileLen(fn)
End If
Next i
'Dateien verschieben
For i = 2 To zeile
If (Cells(i, 4) > Cells(i, 2)) Or Cells(i, 4) = 0 Then
If Cells(i, 4) > 0 Then
Cells(i, 6) = "Kill " & Cells(i, 3) & Cells(i, 1)
Kill Cells(i, 3) & Cells(i, 1)
End If
Cells(i, 7) = "Name " & path & "NEU\" & Cells(i, 1) & " As " & Cells(i, 3) & Cells(i, 1)
Name path & "NEU\" & Cells(i, 1) As Cells(i, 3) & Cells(i, 1)
Else
If Cells(i, 4) > 0 Then Cells(i, 5) = "nicht verschoben!"
End If
Next i
End Sub

...und schau mal in die Spalten F und G. Hier schreibt der Code dir Befehle rein, die er auch ausführt.
Gruß Matthias
Anzeige
AW: Dateien verschieben mit Excel
Andreas
Hi nochmal,
hab ich getestet, ist aber wie vorher, mit den Dateien geschieht nichts.
Schau mal auf dem Screenshot, da ist eine Datei A2.JPG, die im Ordner NEU mit 37 MB ist. Diese müßte eigentlich nach dem Durchlauf des Makros in dem Ordner A landen (vorhandene Datei ist kleiner und wird somit überschrieben). Die bleibt aber im Ordner NEU und die kleinere vorhandene Datei wird nicht ersetzt.
Die Datei A3.JPG ist im Ordner A noch nicht vorhanden und müßte demnach von NEU in A verschoben werden.
Wenn Du magst und Zeit und Lust hast wäre es nett, wenn Du nochmal schauen könntest.
Vielen Dank auf jeden Fall schonmal für Deine Mühe.
Gruß
Andreas
Userbild
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 22:17:21
Matthias
Hallo Andreas,
kleine Ursache, große Wirkung...

'Dateien verschieben
For i = 2 To zeile
If (Cells(i, 2) > Cells(i, 4)) Or Cells(i, 4) = 0 Then 'GRÖSSER muss es heißen

Übrigens ein sehr cooler Bildschirmausschnitt :-) Wie machst du das?
Gruß Matthias
AW: Dateien verschieben mit Excel
07.08.2005 22:23:10
Andreas
Den Bildschirmausschnitt mache ich mit dem Programm Hardcopy (www.hardcopy.de).
Schau mal dort auf der Internetseite. Ist echt ganz genial.
Könntest Du mir den kompletten Makrocode nochmal posten, sehe gerade nicht genau, wo ich was ändern muss :-)
Gruß
Andreas
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 22:30:21
Matthias
Hallo Andreas,
der Kommentar war aber auch irreführend - das größer ist ja auch geblieben...
aber nicht Spalte 4 größer Spalte 2

If (Cells(i, 4) > Cells(i, 2)) Or Cells(i, 4) = 0 Then

sondern Spalte 2 größer Spalte 4

If (Cells(i, 2) > Cells(i, 4)) Or Cells(i, 4) = 0 Then

Die zwölfte Zeile von unten...
Viel Erfolg,
Matthias
AW: Dateien verschieben mit Excel
07.08.2005 22:36:55
Andreas
Aber es verschiebt nichts ;-(
Die Datei A2.JPG mit 37 MB ist noch wie vor unverändert in NEU, wird aber nicht in A verschoben. Die Datei A3.JPG verbleibt auch in NEU und wird auch nicht in A verschoben.
Ist bestimmt noch irgendwo ne Kleinigkeit. Würde ja gerne helfen, aber....... ;-)
Gruß
Andreas
Anzeige
AW: Dateien verschieben mit Excel
07.08.2005 22:37:50
Andreas
Aber es verschiebt nichts ;-(
Die Datei A2.JPG mit 37 MB ist noch wie vor unverändert in NEU, wird aber nicht in A verschoben. Die Datei A3.JPG verbleibt auch in NEU und wird auch nicht in A verschoben.
Ist bestimmt noch irgendwo ne Kleinigkeit. Würde ja gerne helfen, aber....... ;-)
Gruß
Andreas
AW: Dateien verschieben mit Excel
07.08.2005 22:50:15
Matthias
Hallo Andreas,
also hier nochmal komplett, auch mit Fehlerbehandlung.
Die MsgBox-Zeilen kannst du später löschen oder auskommentieren.

Sub Verschieben()
Dim path As String
Dim fn As String
Dim zeile As Long, i As Long
Dim k As Boolean
zeile = 1
Cells.ClearContents
Cells(1, 1) = path & "NEU\"
Cells(1, 2) = "Größe neu"
Cells(1, 3) = "Verz."
Cells(1, 4) = "Größe alt"
Cells(1, 6) = "Aktion"
path = ThisWorkbook.path & "\Bilder\"
'Dateinamen und -größe in Tabelle schreiben
fn = Dir(path & "Neu\*.jpg")
Do While fn <> ""
zeile = zeile + 1
Cells(zeile, 1) = fn
Cells(zeile, 2) = FileLen(path & "Neu\" & fn)
fn = Dir()
Loop
'nach gleichnamigen in Verzeichnissen suchen
For i = 2 To zeile
fn = path & Left(Cells(i, 1), 1) & "\" & Cells(i, 1)
Cells(i, 3) = path & Left(Cells(i, 1), 1) & "\"
If Dir(fn) = "" Then
Cells(i, 4) = 0
Else
Cells(i, 4) = FileLen(fn)
End If
Next i
'Dateien verschieben
On Error Resume Next
For i = 2 To zeile
If (Cells(i, 2) > Cells(i, 4)) Or Cells(i, 4) = 0 Then
If Cells(i, 4) > 0 Then
MsgBox "Kill " & Cells(i, 3) & Cells(i, 1)
Kill Cells(i, 3) & Cells(i, 1)
If Err.Number > 0 Then
Cells(i, 5) = Err.Description
Err.Clear
Else
Cells(i, 5) = "gelöscht"
End If
End If
MsgBox "Name " & path & "NEU\" & Cells(i, 1) & " As " & Cells(i, 3) & Cells(i, 1)
Name path & "NEU\" & Cells(i, 1) As Cells(i, 3) & Cells(i, 1)
If Err.Number > 0 Then
Cells(i, 6) = Err.Description
Err.Clear
Else
Cells(i, 6) = "verschoben"
End If
Else
If Cells(i, 4) > 0 Then Cells(i, 6) = "nicht verschoben"
End If
Next i
End Sub

Gruß Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige