Déplacer des fichier dans des sous dossier en fonction de leur date de création

Question

Bonjour

J'ai de nombreux fichiers dans un repertoire créé chaque soir par un batch,
je souhaiterai via une macro sous excel, trier ce répertoire en déplacant les fichiers dans des sous repertoires (corespondant au mois-annee de création du fichier)
Exemple:
j'ai un fichier créé le 08/01/2009 je souhaite que le script déplace ce fichier dans le dossier 01-2009 et si le dossier n'existe pas le creer
Merci de votre aide

cs_Jack · Answer

Salut
Pour lister les répertoires, fichiers, créer des répertoires ou fichier ... il y a FileSystemObject.
Si ta macro crée elle même les fichiers, il sera plus facile d'utiliser la date du jour que de rechercher celle des fichiers.
Pour trouver la date d'un fichier --> Tape "vbs date fichier" dans la recherche des Codes du site en excluant .NET
Idem pour FileSystemlObject, souvent appelé FSO

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Orohena · Answer

Salut

En VBA ca donne ça (je ne connais pas vbscript, mais je suppose que ce n'est pas très différent du VBA)

Option Explicit

Sub traiter()
    Dim repSource As String, repDest As String
    repSource = "C:\Documents and Settings\Mes documents	emp1" ' nom du répertoire source
    repDest = "C:\Documents and Settings\Mes documents	emp2"     ' nom du répertoire de destination
    triDeplacement repSource, repDest
End Sub

Sub triDeplacement(repSource As String, repDest As String)
    Dim fs, folder, fichier
    Dim dateCreation As Date
    Dim nomRep As String
    Dim i As Integer
    Set fs = CreateObject("Scripting.FileSystemObject") ' le voila, le fameux fileSystemObject dont parle Jack !
    Set folder = fs.getfolder(repSource)
    For Each fichier In folder.Files
        dateCreation = fichier.datecreated
        nomRep = Format(Month(dateCreation), "00") & "-" & Year(dateCreation)
        If Not fs.folderexists(repDest & "" & nomRep) Then MkDir repDest & "" & nomRep
        fs.movefile repSource & "" & fichier.Name, repDest & "" & nomRep & "" & fichier.Name
    Next
End Sub



Amicalement

cs_Orohena · Answer

Tu te demandes sans doute pourquoi j'ai mis un Dim i As Integer qui n'est pas du tout nécessaire ?

Ben, euh ... disons que c'est un cadeau ; j'y peux rien, c'est ma nature, j'ai le coeur sur la main...

cs_JMO · Answer

Bonjour,

Option Explicit
Const cstPathSource = "D:\TEST"
Const cstPathDest = "D:\TEST_ARCHIV"

Dim objFso, objFile, strDate, strDateMonth
Set objFso = CreateObject("Scripting.FileSystemObject")

For Each objFile in objFso.GetFolder(cstPathSource).Files
    strDateMonth = Month(objFile.DateLastModified)    If Len(strDateMonth) 1 Then strDateMonth "0" & strDateMonth
    strDate = strDateMonth & "-" & Year(objFile.DateLastModified)
    
    If Not objFso.FolderExists(cstPathDest & strDate) Then
       objFso.CreateFolder(cstPathDest & strDate)
       objFso.MoveFile objFile.Path, cstPathDest & strDate & "" & objFile.Name
    Else
       objFso.MoveFile objFile.Path, cstPathDest & strDate & "" & objFile.Name
    End If 
Next

Set objFso = Nothing

Attention à la propriété DateCreated, je lui préfère DateLastModified.

jean-marc

benzure · Answer

Bonjour a vous,

Merci pour votre rapidité de réponses.

Effectivement, il vaut mieux utilisé DateLastModified.

Cela fonctionne parfaitement,

Maintenant comment je peux dans le dossier source parcourir des sous dossier

Merci d'avance

benzure · Answer

Il existe   SearchSubFolders = True
Mais a quel endroit je dois le placer?

cs_JMO · Answer

Bonsoir,

Exemple pour lister les fichiers des sous-répertoires.
Option Explicit
Sub ShowFilesList(argFolder)
    Dim objFile, subFolder
    For Each objFile In argFolder.Files
        If DateDiff("d", objFile.DateCreated,Date) > cstNbrJour Then
           Set objDicoFiles(objFile.Path) = objFile
        End if
    Next
    For Each subFolder In argFolder.SubFolders
        Call ShowFilesList(subFolder)
    Next
End Sub

Const cstNbrJour = 2
Dim objFso, objDicoFiles
Dim strPath, arrDicoKeys
strPath = "F:\SCRIPTS\TEST" 'Dossier à modifier

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objDicoFiles = CreateObject("Scripting.Dictionary")

Call ShowFilesList(objFso.GetFolder(strPath))
MsgBox Join(objDicoFiles.Keys,vbCr) 

Set objFso = Nothing
Set objDicoFiles = Nothing

jean-marc

Déplacer des fichier dans des sous dossier en fonction de leur date de création

7 réponses

Votre réponse

Discussions similaires