Function file_move()
'Autor: Heiko Hommes
'Datum: 06.12.2007
'Beschr.: Es werden Dateien aus einem Verzeichniss bezogen auf's
'         Erstellungsdatum in ein Verzeichniss Jahr=>Monat verschoben
'         \Pfad\2007\01
'         \Pfad\2007\02 ...


On Error GoTo fehler

Dim pfad_quelle As String
Dim file As String
Dim file_tstamp As String
Dim jahr As String
Dim monat As String
Dim va_kz_j_m As String 'kz, ob Verzeichniss Jahres oder Monatsverzeichniss fehlt

pfad_quelle = "D:\Archiv\Freizeit\artikel_del_neu\"

file = Dir(pfad_quelle & "*.pdf")
Do While file <> ""
    file_tstamp = FileDateTime(pfad_quelle & file)    'Zeitstempel holen
    jahr = Mid(file_tstamp, 7, 4)
    monat = Mid(file_tstamp, 4, 2)
    MkDir pfad_quelle & jahr
    MkDir pfad_quelle & jahr & "\" & monat
    FileCopy pfad_quelle & file, pfad_quelle & jahr & "\" & monat & "\" & file
    If FileLen(pfad_quelle & jahr & "\" & monat & "\" & file) > 0 Then
        Kill (pfad_quelle & file)
    End If
    file = Dir   'nächste Datei holen
    
Loop

MsgBox ("Na .... das ging doch schnell...oder")

Exit Function

fehler:
    If Err.Number = 75 Then  'Pfad nicht vorhanden
        Resume Next
    Else
        MsgBox ("Fehler: " & Err.Number & Err.Description)
    End If

End Function