MkDir ("C:\TEMP\test\" & Year(Date) & "/" & Month(Date))

 
    Dim fso, oFile, oFiles, oFolder
    Dim sdebut, sFin, sMsg
 
    On Error Resume Next
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fso.GetFolder("C:\TEMP\test")
    Set oFiles = oFolder.Files
 
    sFin = "C:\TEMP\FileKopieren\"
 
    For Each oFile In oFiles
     sdebut = fso.GetAbsolutePathName(oFile)
     fso.MoveFile sdebut, sFin
 
     If Err.Number <> 0 Then
      sMsg = Err.Description
 
      Select Case Err.Number
       Case 58
        sMsg = sMsg & vbCrLf & vbCrLf & sdebut
       Case 76
        sMsg = sMsg & vbCrLf & vbCrLf & sFin
       Case Else
        sMsg = sMsg
      End Select
 
      MsgBox sMsg, 48, "Fehler!"
      Err.Clear
     End If
    Next
 
    MsgBox "Files kopiert", 64, "Info"
 
End Sub