Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
940to944
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
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ordner erstellen entspr. Datum der Dateien

Ordner erstellen entspr. Datum der Dateien
11.01.2008 07:42:00
Andreas
Guten Morgen,
ich bitte dringend um Hilfe,
Ich habe ein Verzeichnis mit vielen Fotos unterschiedlichen Erstelldatums. Ich bräuchte ein Makro, welches mir in das Verzeichnis entsprechend der 'Erstelldatümer' Unterverzeichnisse erstellt und die entsprechenden Fotos in diese Ordner verschiebt bzw. kopiert.
z.B.:
Ein Foto im Verzeichnis wurde am 11.01.2008 aufgenommen.
Einen Ordner erstellen, mit dem Namen "2008_01_11".
in diesen Ordner wird dieses und alle Fotos verschoben/kopiert mit dem Erstelldatum 11.01.2008.
Das nächste Foto im Verzeichnis wurde am 10.01.2008 aufgenommen.
Erstelle Ordner "2008_01_10"
etc.
Ist sowas machbar?
Würde mir sehr viele Stunden sparen.
Gruß
Andreas

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner erstellen entspr. Datum der Dateien
11.01.2008 14:37:00
fcs
Hallo Andreas,
hier mein Lösungsvorschlag (erstellt mit Excel 2003)
Gruß
Franz

Sub PhotoEinsortieren()
Dim PfadDatei As Variant, Datum As Date, DatumDir As String, Datei As String
Dim Verzeichnis As String, i As Integer
Verzeichnis = "C:\Lokale Daten\Test\Test_Test"
With Application.FileSearch
.FileType = msoFileTypeAllFiles
.LookIn = Verzeichnis
.Execute
For Each PfadDatei In .FoundFiles
Datum = VBA.FileDateTime(PfadDatei)
DatumDir = Format(Datum, "YYYY_MM_DD")
If Dir(Pathname:=Verzeichnis & "\" & DatumDir, Attributes:=vbDirectory) = "" Then
VBA.MkDir Verzeichnis & "\" & DatumDir
End If
For i = Len(PfadDatei) To 1 Step -1
If Mid(PfadDatei, i, 1) = "\" Then Exit For
Datei = Mid(PfadDatei, i, 1) & Datei
Next
VBA.FileCopy PfadDatei, Verzeichnis & "\" & DatumDir & "\" & Datei
VBA.Kill PfadDatei
Next
End With
End Sub


Anzeige
AW: Ordner erstellen entspr. Datum der Dateien
14.01.2008 07:17:00
Andreas
Guten Morgen Franz,
sorry, dass ich mich heute erst melde, bin erst seit eben wieder an meinem Rechner.
Danke für deinen Vorschlag, ist im Prinzip genau was ich benötige.
Allerdings bekomme ich einen Lauzfeitfehler in dieser Zeile:
VBA.FileCopy PfadDatei, Verzeichnis & "\" & DatumDir & "\" & Datei
Und dann entstehen manchmal solche Dateinamen:
PIC00004.JPGPIC00003.JPG
Bekommst Du das vielleicht noch hin?
Gruß
Andreas

AW: Ordner erstellen entspr. Datum der Dateien
14.01.2008 08:13:00
fcs
Hallo Andreas,
ich hatte das zurücksetzen des Dateinamens nach dem Kopiervorgang vergessen, wobei ich bei den wenigen Testdateien kein Problem hatte. Mit der folgenden Anpassung sollte es funktionieren.
Gruß
Franz

Sub PhotoEinsortieren()
Dim PfadDatei As Variant, Datum As Date, DatumDir As String, Datei As String
Dim Verzeichnis As String, i As Integer
Verzeichnis = "C:\Lokale Daten\Test\Test_Test"
With Application.FileSearch
.FileType = msoFileTypeAllFiles
.LookIn = Verzeichnis
.Execute
For Each PfadDatei In .FoundFiles
Datum = VBA.FileDateTime(PfadDatei)
DatumDir = Format(Datum, "YYYY_MM_DD")
If Dir(Pathname:=Verzeichnis & "\" & DatumDir, Attributes:=vbDirectory) = "" Then
VBA.MkDir Verzeichnis & "\" & DatumDir
End If
For i = Len(PfadDatei) To 1 Step -1
If Mid(PfadDatei, i, 1) = "\" Then Exit For
Datei = Mid(PfadDatei, i, 1) & Datei
Next
VBA.FileCopy PfadDatei, Verzeichnis & "\" & DatumDir & "\" & Datei
VBA.Kill PfadDatei
Datei = ""
Next
End With
End Sub


Anzeige
AW: Ordner erstellen entspr. Datum der Dateien
14.01.2008 08:41:00
Andreas
Funktioniert perfekt!!!
Danke Franz :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige