Copier des fichiers d’un répertoire vers un autre créé automatiquement

Salut à tous,

j’ai deux Code:

- un pour créer automatiquement un répertoire

Code:

1
2
3
Sub testRepertoire()
    MkDir ("C:\TEMP\test\" & Year(Date))
 End Sub

- un autre pour copier des fichiers d’un répertoire à un autre.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub copierFichier()
 
    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\FichierCopier\"
 
    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, "Faute!"
      Err.Clear
     End If
    Next
 
    MsgBox "Fichiers chargé", 64, "Info"
 
End Sub

Les deux programmes fonctionnent bien. Mon problème est le suivant comment copier des fichier d’un répertoire C:\Temp vers un répertoire C:\Temp\2011, où le sous répertoire 2011 sera créer automatiquement lors de la procédure de déplacement des fichiers ?

Merci d’avance pour vos réponses