Copie de TOUS les fichiers d'extensions .xls

Version imprimable

Bonjour à tous,

Déjà je m'excuse d'avance mais je suis débutante en VBA.
Je vais essayer d'expliquer mon problème, je voudrais pouvoir copier tous les fichiers d'extension .xls dont la date de modification est du 26/03/2009 puis le coller dans le dossier de l'année de la modification, c'est a dire ici 2009.

Voici mon code,
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub test_essai_macro() Lannee = (Year(Now)) DateF = FileDateTime("F:\EXCEL\Bilans classeurs\ & .xls") DateR = "26/03/2009" If (InStr(DateF, DateR)) > 0 Then 'Sub copiercoller() FileCopy "F:\EXCEL\Bilans classeurs\&.xls", "F:\EXCEL\Bilans classeurs\2009\&.xls" Else End If End Sub
Merci beaucoup à tous ceux qui vont réfléchir sur mon code
Bonne journée !

Salut,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub SearchFiles()
    Dim DateMod As String
    Dim fs As Object, fil As Object
 
    Set fs = CreateObject("Scripting.FilesystemObject")
    DateMod = "26/03/2009"
    For Each fil In fs.GetFolder("F:\EXCEL\Bilans classeurs\").Files
        If Left(fil.DateLastModified, 10) = DateMod Then
            FileCopy "F:\EXCEL\Bilans classeurs\" & fil.Name", "F:\EXCEL\Bilans classeurs\2009\" & fil.Name"
        End If
    Next
End Sub

Ca devrait marcher.

A+

14/06/2010, 14h02
madm-selleso

Salut DeaD78,

ça ne marche pas, un problème au niveau de :

Code:

FileCopy "F:\EXCEL\Bilans classeurs\" & fil.Name", "F:\EXCEL\Bilans classeurs\2009\" & fil.Name"

Par contre je ne comprends pas, le fil.Name correspond à quoi ? A tous les fichiers avec l'extension .xls ?

Encore désolée ... :/ Mais j'essaie de comprendre le code pour essayer de trouver l'erreur mais sans succès !!
14/06/2010, 14h46
DeaD78

Je me suis trompé en recopiant la ligne :

Code:

FileCopy "F:\EXCEL\Bilans classeurs\" & fil.Name, "F:\EXCEL\Bilans classeurs\2009\" & fil.Name

Là ça marchera, j'ai testé chez moi.

fil.Name correspond juste au nom de ton fichier ayant la bonne date de modification. Vu que tu es dans une boucle vu qu'il peut y en avoir plusieurs, cela correspond au nom des fichiers l'un après l'autre.

Super :ccool: ça marche parfaitement. Merci beaucoup !! :)

Seulement j'abuse encore de votre gentille et j'en suis désolée ! Mais en faite ces fichiers devront être coller dans les dossiers non créer en fonction du mois et de l'année de la date de modification du fichier!

Exemple:
J'ai 3 fichiers .xls dont la date de modification est du 14-06-2010, alors il faudrait les copier dans le dossier "Juin 2010" que l'ont devra créer

J'ai essayer ceci comme code, mais apparament ce n'est pas ça !!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub rangement_dossier() Dim DateMod As String Dim fs As Object, fil As Object Lannee = (Year(Now)) Lemois = (Month(Now)) Set fs = CreateObject("Scripting.FilesystemObject") DateMod = "14/" & Lemois & Lannee For Each fil In fs.GetFolder("D:\EXCEL\Bilans\classeur").Files If Left(fil.DateLastModified, 10) = DateMod Then FileCopy "D:\EXCEL\Bilans\classeur\" & fil.Name, "D:\EXCEL\Bilans\classeur\&Lemois & Lannee & " \ " & fil.Name" End If Next End Sub
Encore désolée de demander encore et encore mais j'essaie de progresser en VBA !!
Merci beaucoup d'avance !!!

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
Sub Test()
    Dim DateMod As String
    Dim fs As Object, fil As Object
    Dim Year As String
    Dim Month As String
    Dim Chemin$
 
    Set fs = CreateObject("Scripting.FilesystemObject")
    DateMod = "26/03/2009"
 
    Chemin = "F:\EXCEL\Bilans classeurs\"
 
    For Each fil In fs.GetFolder(Chemin).Files
        If Left(fil.DateLastModified, 10) = DateMod Then
            Year = Mid(fil.DateLastModified, 7, 4)
            Month = Mid(fil.DateLastModified, 4, 2)
            If Month = "01" Then Month = "Janvier"
            End If
            If Month = "02" Then Month = "Février"
            End If
            If Month = "03" Then Month = "Mars"
            End If
            'Etc
            MkDir (Chemin & Month & " " & Year)
            FileCopy "F:\EXCEL\Bilans classeurs\" & fil.Name, "F:\EXCEL\Bilans classeurs\" & Month & " " & Year & "\" & fil.Name
        End If
    Next
End Sub

Cela fait exactement ce que tu souhaites. Finis de compléter le 'Etc :ccool:

Bonne soirée.

:)Voila j'ai completé le Ect ... J'ai quelques petites questions ...

Deja le code marche sans

Code:

MkDir (Chemin & Month & " " & Year)

Bizarre non ? 8O !!
Ensuite, je voudrais avoir si possible l'explication de ceci

Code:

1
2
3
Left(fil.DateLastModified, 10) = DateMod Then
            Year = Mid(fil.DateLastModified, 7, 4)
            Month = Mid(fil.DateLastModified, 4, 2)

Que represente le 7, le 4 et le 2 ?? 8O

J'ai essayé ceci

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
Sub Test()
    Dim DateMod As String
    Dim fs As Object, fil As Object
    Dim Year As String
    Dim Month As String
    Dim Chemin$
 
    Set fs = CreateObject("Scripting.FilesystemObject")
    DateMod = Now
 
    Chemin = "F:\STAGE\Bilans classeurs\OK\classeur_VM\"
 
    For Each fil In fs.GetFolder(Chemin).Files
        If Left(fil.DateLastModified, 10) = DateMod Then
            Year = Mid(fil.DateLastModified, 7, 4)
            Month = Mid(fil.DateLastModified, 4, 2)
            If Month = "01" Then Month = "Janvier"
            If Month = "02" Then Month = "Février"
            If Month = "03" Then Month = "Mars"
            If Month = "04" Then Month = "Avril"
            If Month = "05" Then Month = "Mai"
            If Month = "06" Then Month = "Juin"
            If Month = "07" Then Month = "Juillet"
            If Month = "08" Then Month = "Août"
            If Month = "09" Then Month = "Septembre"
            If Month = "10" Then Month = "Octobre"
            If Month = "11" Then Month = "Novembre"
            If Month = "12" Then Month = "Décembre"
 
        '    MkDir (Chemin & Month & " " & Year)
            FileCopy "F:\STAGE\Bilans classeurs\OK\classeur_VM\" & fil.Name, "F:\STAGE\Bilans classeurs\OK\classeur_VM\" & Month & " " & Year & "\" & fil.Name
        End If
    Next
End Sub

Car votre code marche très bien mais seulement, la date de modification change tout le temps, or c'est une macro qui doit s'éxécuter automatiquement sachant que si la date est en avril 2011 alors il doit créer et tout mettre dans le dossier avril 2011 !!
Je sais pas si mon explication est très clair :/

En tout cas, merci beaucoup pour votre aide très précieuse !!
Je continue de chercher, pr le moment avec le Now ici :

Code:

1
2
3
4
5
6
    DateMod = Now
 
    Chemin = "F:\STAGE\Bilans classeurs\OK\classeur_VM\"
 
    For Each fil In fs.GetFolder(Chemin).Files
        If Left(fil.DateLastModified, 10) = DateMod Then

ça ne marche pas :cry: !!

Bonne journée 8-) et à bientôt

Pour avoir la date je pense avoir réussis !!
Cependant, j'ai une erreur au niveau du filecopy et je ne comprends pas pourquoi :cry:

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
Sub Test()
    Dim DateMod As String
    Dim fs As Object, fil As Object
    Dim Year As String
    Dim Month As String
    Dim Chemin$
 
    Set fs = CreateObject("Scripting.FilesystemObject")
    DateMod = Format(Now, "dd/mm/yyyy")
 
    Chemin = "F:\STAGE\Bilans classeurs" '\OK\classeur_VM\"
 
    For Each fil In fs.GetFolder(Chemin).Files
        If Left(fil.DateLastModified, 10) = DateMod Then
            Year = Mid(fil.DateLastModified, 4, 2)
            If Year = "10" Then Year = 2010
            Month = Mid(fil.DateLastModified, 7, 4)
            If Month = "01" Then Month = "Janvier"
            If Month = "02" Then Month = "Février"
            If Month = "03" Then Month = "Mars"
            If Month = "04" Then Month = "Avril"
            If Month = "05" Then Month = "Mai"
            If Month = "06" Then Month = "Juin"
            If Month = "07" Then Month = "Juillet"
            If Month = "08" Then Month = "Août"
            If Month = "09" Then Month = "Septembre"
            If Month = "10" Then Month = "Octobre"
            If Month = "11" Then Month = "Novembre"
            If Month = "12" Then Month = "Décembre"
 
           ' MkDir (Chemin & Month & " " & Year)
            FileCopy "F:\STAGE\Bilans classeurs\" & fil.Name, "F:\STAGE\Bilans classeurs\" & Month & " " & Year & "\" & fil.Name
        End If
    Next
End Sub

Merci encore pour ceux qui vont se pencher sur mon code !!

15/06/2010, 12h45
DeaD78
Salut,

Code:

MkDir (Chemin & Month & " " & Year)

Cette ligne crée tout simplement le répertoire en fonction du mois et de l'année comme tu le souhaitais.
Code:

1 2 Year = Mid(fil.DateLastModified, 7, 4) Month = Mid(fil.DateLastModified, 4, 2)
Year est égal aux caractères correspondant à l'année de fil.DateLastModified. 7 et 4 : on extrait à partir du 7ème caractères les 4 caractères correspondant à l'année. C'est juste de l'extraction de chaînes de caractères : tu as un très bon tuto sur ce site sur le sujet si tu es intéressée.

Month équivaut à la même chose mais selon les caractères du mois : on extrait 2 caractères à partir du 4ème de fil.DateLastModified. On se retrouve donc avec 01,02,..,12. Les If permettent donc de transformer cela en mois lettrés (janvier, février etc.).

Ceci est donc dynamique. Selon la valeur de fil.DateLastModified qui est dynamique (correspond au clic droit/propriétés sur ton fichier), le répertoire va être créé dynamiquement. En clair, ça fait ce que tu souhaites dynamiquement : si le fichier a été modifié en février 2010, le répertoire février 2010 sera créé.

Ce n'est pas la peine de changer tant de choses dans le code que je t'ai donné, c'est conçu pour fonctionner automatiquement.

Seulement, tu m'avais dit ça :

Citation:

je voudrais pouvoir copier tous les fichiers d'extension .xls dont la date de modification est du 26/03/2009

J'ai donc effectué un test sur cette date :

Code:

If Left(fil.DateLastModified, 10) = DateMod Then

avec

Code:

DateMod = "26/03/2009"

.

Si tu veux faire la même chose peu importe la date (en gros, prendre TOUS les fichiers et les mettre dans le répertoire où ils doivent être mis), il faut enlever les lignes

Code:

DateMod = "26/03/2009"

et
Code:

1 2 If Left(fil.DateLastModified, 10) = DateMod Then End If
du code que je t'ai donné en dernier.

Le code parcourra tous les fichiers de ton répertoire source et copiera tous ces fichiers dans le répertoire cible qui aura été créé en fonction de leur date de modification et cela peu importe le fichier.

En revanche, je ne sais pas si tu auras une erreur avec MkDir si le répertoire est déjà créé (si tu as 2 fichiers ayant les mêmes mois et année). Teste et dis-moi. Si tu as une erreur, il faudra simplement faire un test voir si le répertoire est déjà créé. S'il l'est, tu sautes la création avec MkDir. Sinon, ben tu continues le process normal.

Bonne chance pour la suite.

EDIT : dans ton code tu as des erreurs de raisonnement. Tout d'abord, tu ne fais ce que tu veux faire seulement si la date de modification est égale à la date d'aujourd'hui.

De plus, MkDir permet de créer un répertoire. Tu l'as mis en commentaire. Du coup, le FileCopy ne peut pas copier un fichier dans un répertoire n'existant pas.

Bonjour,

Merci beaucoup pour toutes ces explications et toutes ces réponses :ccool: !!

J'ai fais des test , lorsque le dossier n'exite pas il me le créer seulement quand il existe deja il plante !! :cry:

Mais dans les 2 cas, le

Code:

FileCopy "F:\STAGE\Bilans classeurs\" & fil.Name, "F:\STAGE\Bilans classeurs\" & Month & " " & Lannee & "\" & fil.Name

plante aussi !! Et je ne comprends pas trop pourquoi !!

J'ai aussi changé les dates car apparament quand le fichier date de Juin il faut le placer dans le dossier Mai !! Mais ça c'est réglé ! Un jeu d'enfant !! enfin je pense que c'est bon :? !!

Voici mon code actuel:
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 Sub Test() Dim DateMod As String Dim fs As Object, fil As Object Dim Month Dim Chemin$ Dim Lannee As String Set fs = CreateObject("Scripting.FilesystemObject") Chemin = "F:\STAGE\Bilans classeurs\" For Each fil In fs.GetFolder(Chemin).Files Lannee = Mid(fil.DateLastModified, 7, 4) Month = Mid(fil.DateLastModified, 4, 2) If Month = "02" Then Month = "Janvier" If Month = "03" Then Month = "Février" If Month = "04" Then Month = "Mars" If Month = "05" Then Month = "Avril" If Month = "06" Then Month = "Mai" If Month = "07" Then Month = "Juin" If Month = "08" Then Month = "Juillet" If Month = "09" Then Month = "Août" If Month = "10" Then Month = "Septembre" If Month = "11" Then Month = "Octobre" If Month = "12" Then Month = "Novembre" If Month = "01" Then Month = "Décembre" MkDir (Chemin & Month & " " & Lannee) FileCopy "F:\STAGE\Bilans classeurs\" & fil.Name, "F:\STAGE\Bilans classeurs\" & Month & " " & Lannee & "\" & fil.Name Next End Sub
J'ai donc essayé de faire un test pour le MkDir ... mais j'y suis pas arrivée !

Code:

If Dir(Chemin & Month & " " & Lannee) = " " Then MkDir (Chemin & Month & " " & Lannee) Else FileCopy "F:\STAGE\Bilans classeurs\" & fil.Name, "F:\STAGE\Bilans classeurs\" & Month & " " & Lannee & "\" & fil.Name

Je me doute que si le dossier n'est pas crée, je ne peux pas retrouver

Code:

Dir(Chemin & Month & " " & Lannee)

Merci encore !! J'espère que je vais finir par y arriver, en tout cas merci car grâce a toi j'ai appris plein de choses !!!

Bonjour,

Voici ton code final qui fonctionne :

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
39
40
41
'Fonction qui vérifie si le dossier spécifié existe
Function RepertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RepertoireExiste = GetAttr(Chemin) And vbDirectory
End Function
 
Sub Test()
    Dim DateMod As String
    Dim fs As Object, fil As Object
    Dim Month As String
    Dim Lannee As String
    Dim Chemin$
 
    Set fs = CreateObject("Scripting.FilesystemObject")
    Chemin = "F:\STAGE\Bilans classeurs\"
 
    For Each fil In fs.GetFolder(Chemin).Files
 
            Lannee = Mid(fil.DateLastModified, 7, 4)
            Month = Mid(fil.DateLastModified, 4, 2)
 
            If Month = "02" Then Month = "Janvier"
            If Month = "03" Then Month = "Février"
            If Month = "04" Then Month = "Mars"
            If Month = "05" Then Month = "Avril"
            If Month = "06" Then Month = "Mai"
            If Month = "07" Then Month = "Juin"
            If Month = "08" Then Month = "Juillet"
            If Month = "09" Then Month = "Août"
            If Month = "10" Then Month = "Septembre"
            If Month = "11" Then Month = "Octobre"
            If Month = "12" Then Month = "Novembre"
            If Month = "01" Then Month = "Décembre"
 
            If Not (RepertoireExiste(Chemin & Month & " " & Lannee)) Then
                MkDir (Chemin & Month & " " & Lannee)
            End If
            FileCopy Chemin & fil.Name, Chemin & Month & " " & Lannee & "\" & fil.Name
 
    Next
End Sub

La fonction va se charger de vérifier si le répertoire existe déjà. S'il n'existe pas, on passe au MkDir. Il s'agit d'un appel de fonction des plus classiques. Ainsi, si le répertoire existe déjà, pas de MkDir et donc pas de plantage.

J'ai également simplifié le FileCopy sachant qu'on a une variable pour désigner le chemin plutôt que tout réécrire. En tout cas, le FileCopy ne plante pas chez moi. Peut-être est-ce à cause du fait que tu n'as pas défini le Month en tant que String.

Le code est parfaitement fonctionnel chez moi et fait tout ce que tu souhaites. Fais un copier/coller et remplace tout ton code pour être sûre que tu n'auras aucun écart et lance-le tel quel.

Bonne chance !

16/06/2010, 15h14
madm-selleso

Merci pour tout mais alors je pense que ça vient de mon PC si ça ne marche pas :cry::cry: !!

L'erreur est toujours au même endroit soit au

Code:

FileCopy Chemin & fil.Name, Chemin & Month & " " & Lannee & "\" & fil.Name

!! Et pourtant j'ai bien fais le copier coller :/ !!

Si je met ce code en commentaire, il me crée bien tous les dossiers comme je veux :ccool: Merci beaucoup

Je suis désolée de causer autants de problèmes :? !!
16/06/2010, 16h18
DeaD78

Vérifie bien le

Code:

Chemin = "F:\STAGE\Bilans classeurs\"

Est-ce la bonne orthographe, ne t'es-tu pas trompée quelque part ? C'est sensible à la casse donc la moindre majuscule (Classeurs ou Stage ?) ou un espace en trop à la fin et c'est l'erreur.

Sinon, plus d'erreur si le répertoire est déjà créé ?
17/06/2010, 08h40
madm-selleso

Oui il n'y a pas d'erreurs, j'ai même fait un copier de l'adresse pour ne pas avoir d'erreurs !!!

Il me disent "erreur d'éxécution '70' : permission refusée" !! J'ai même changé les noms des dossiers et changer d'ordinateur et l'erreur est toujours la même !!

Mais je suis sous excel 2003; c'est peut etre pour ça non ?

Sinon pour les dossiers, ça marche impécable même quand il est déjà crée !!
17/06/2010, 10h59
DeaD78

Il faut simplement que tous tes fichiers soient fermés lorsque tu lances la macro :roll:

Tu ne peux pas mettre une FileCopy sur un fichier ouvert :calim2:

Teste et dis-moi !
17/06/2010, 14h01
madm-selleso

ça marche :ccool: !! MERCIIII

En faite c'est juste que mon fichier macro se trouvait dans le dossier ou il fallait prendre tous les fichiers.xls !!

Merci encore à toi et a tout ceux du forum !!