Copier plusieurs fichiers en filtrant sur la date de création

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

Je cherche a copier plusieurs fichier d'un emplacement "source" vers un emplacement "destination" en ouvrant une fenetre de dialogue.
le souci c'est que dans le répertoire "source" j'ai plusieur fichiers, et je voudrais copier seulement les fichiers créer à une certaine date (date du jour). c'est possible de faire ce filtre sous VBA ?

Voici le code qui me permet de copier les fichiers mais sans le filtre (je le fais manuellement a travers la fenetre de dialogue)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Fichiers_Selection_multiple() Dim Fichier As Variant Dim NomFichier As String Dim I As Integer Fichier = Application.GetOpenFilename(Title:="Sélection multiple", MultiSelect:=True) If TypeName(Fichier) = "Boolean" Then Exit Sub Else For I = 1 To UBound(Fichier) NomFichier = Mid(Fichier(I), InStrRev(Fichier(I), "\") + 1) FileCopy Fichier(I), "N:\Projets01\AVANCES_GLOBAL\COMPTA\DEVELLOPEMENT INCIDENTS\DEVELLOPEMENTS\Automatisation comptabilité quotidienne\TEST" & "\" & NomFichier Next End If End Sub
Je vous remercie par avance pour vos lumieres

Cordialement,

Freudsw

04/05/2017, 08h32
riaolle
Bonjour,

Oui, c'est possible ;)
1. Soit ton fichier source est sous forme de tableau Excel et il comporte donc des filtres. Il suffit de récupérer le code correspondant à la manipulation des filtres grâce à l'enregistreur de macro.
2. Soit ton fichier source est sous forme d'une simple plage de cellules, alors tu pourras utiliser les filtres d'Excel.
  1. Soit tu utilises toujours le même fichier et tu mets les filtres manuellement sur ce fichier.
  2. Soit ce sont des fichiers différents à chaque fois, mais avec la même structure et alors, tu peux créer un code qui met les filtres sur ce fichier. Fais le manuellement sur un fichier et obtiens le code grâce à l'enregistreur de macro.
  Ensuite, tu obtiens grâce à l'enregistreur de macro, le code associé à la manipulation des filtres.
Y a plus qu'à adapter les codes obtenus par l'enregistreur de macro.
J'espère que ça te permettra d'avancer ;)
04/05/2017, 13h29
Freudsw

Merci pour ta réponse, mais....

Merci pour ta réponse,

Cepandant, je ne veux pas faire le filtre dans ma page, j'ai pas de données a filtrer.

Au fait, j'ai une macro qui permet de copier un certain nombre de fichiers d'un répertoire vers un autre, j'ai une boite de dialogue qui s'ouvre qui me permet de selectionner les fichiers en question. Ce que je veux faire c'est introduire un filtre dans la macro qui me permet d'affichier seulement les fichier qui sont créés à une certaine date .

Cordialement,

Freudsw
04/05/2017, 13h54
RyuAutodidacte
Bonjour,

Dans ton sub :
tu déclare à partir de quel date tu veux que les fichiers soient copier.
(Schématiquement Si dateDeCréationdeMonFichier >= à MaDate alors copie)
donc,
tu listes le dossier voulu avec Dir en déclarant seulement le type de fichier que tu veux copier (xls, jpg ou autres …)
et dans le listage et sur chaque fichiers trouvés tu applique la date de création avec (pour les déclarations) :
Code:

1 2 Dim Fso Set Fso = CreateObject("Scripting.FileSystemObject")
pour ensuite (dans le code) :

Code:

DateFichier = Fso.GetFile(path & currentPath).DateCreated ' c'est un exemple donc à adapter

ce qui fait non shématisé :
Code:

1 2 3 If DateFichier >= MaDate then 'ton code pour copier End If
Donc utilisé Dir : https://excel.developpez.com/faq/?pa...BoucleFichiers
et dans la boucle faire la comparaison des dates pour copier ou ne pas copier le fichier dans le répertoire voulu

Edit : petite modif de textes

Merci pour ta réponse.

J'ai essayé d'appliquer sur mon code et malheureusement ça ne fonctionne pas, j'exécute la Macro mais rien ne se passe, j'ai du surement zappé quelque chose.

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
Sub Fichiers_Selection_multiple()
Dim Fichier As Variant
Dim NomFichier As String
Dim source14 As String
Dim destination14 As String
Dim I As Integer
Dim MaDate As String
Dim Fso
Dim DateFichier
Dim fichiers As String
 
 
source14 = ThisWorkbook.Worksheets("Source répertoire").Range("B3").Value
fichiers = Dir(source14 & "\" & "*.csv")
destination14 = ThisWorkbook.Worksheets("Source répertoire").Range("B4").Value
MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value
ChDir source14
 
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
DateFichier = Fso.GetFile(fichiers).DateCreated
 
If DateFichier = MaDate Then
Fichier = Application.GetOpenFilename(Title:="Sélection multiple", MultiSelect:=True)
If TypeName(Fichier) = "Boolean" Then
  Exit Sub
Else
  For I = 1 To UBound(Fichier)
    NomFichier = Mid(Fichier(I), InStrRev(Fichier(I), "\") + 1)
    FileCopy Fichier(I), destination14 & "\" & NomFichier
  Next
End If
End If
End Sub

Tu pourrais ou est ce que je me suis plonté dans le code ?

Je te remercie par avance.

Cordialement,
Freudsw

j'ai fait ça vite fait car très peu de temps, je ne l'ai pas testé il faut rajouter le code pour la copie à l'endroit indiqué
affiche la fenêtre des variables locales et fait du pas à pas avec le code avec la touche F8 et regarde ce qu'affiche la fenêtre des variables locales

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
Sub CopieFichiers()
Dim Source As String, Destination As String, MaDate As String, Fichier As String
Dim Fso, DateFichier As String
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    'Définit le répertoire contenant les fichiers
    Source = ThisWorkbook.Worksheets("Source répertoire").Range("B3").Value
    'Définit le répertoire de destination
    Destination = ThisWorkbook.Worksheets("Source répertoire").Range("B4").Value
    MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Source & "*.csv")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")
 
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print Source & Fichier
        DateFichier = Fso.GetFile(Source & Fichier).DateCreated
        If DateFichier = MaDate Then
            Debug.Print Fichier
            'Code pour copier le fichier
            FileCopy Source & Fichier, Destination & Fichier
        End If
        Fichier = Dir()
    Loop
    Set Fso = Nothing
End Sub

Edit : mise à jour du code avec la copie

Merci

Bonjour,

J'ai tetsé le code mais il ne réagit toujours pas...

AU fait mon code me permet actuellement d'ouvrir une fenetre de dialogue qui me permet de visualiser et de selectionner les fichiers que je veux copier grace à cette ligne de code :

Code:

Fichier = Application.GetOpenFilename(Title:="Sélection multiple", MultiSelect:=True)

Dans ton code, je ne vois pas ou placer cette ligne...

Mon code fonctionne parfaitement mais il manque le tri sur la date de création ( si je trie sur ma date de création, il suffit de selectionner tout et le tour est joué) alors que maintenant je dois vraiment selectionner un par un(selon la date de création)

Voici le code qui fonctionne actuellement mais sans le tri sur la date :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Fichiers_Selection_multiple()
Dim Fichier As Variant
Dim NomFichier As String
Dim source As String
Dim destination As String
Dim I As Integer
 
source = ThisWorkbook.Worksheets("Source répertoire").Range("B13").Value
destination = ThisWorkbook.Worksheets("Source répertoire").Range("C13").Value
 
ChDir source
 
Fichier = Application.GetOpenFilename(Title:="Sélection multiple", MultiSelect:=True)
 
If TypeName(Fichier) = "Boolean" Then
  Exit Sub
Else
  For I = 1 To UBound(Fichier)
    NomFichier = Mid(Fichier(I), InStrRev(Fichier(I), "\") + 1)
    FileCopy Fichier(I), destination & "\" & NomFichier
  Next
End If
End Sub

et voici ce que j'ai essayé de faire avec ton code mais sans succés :

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
42
43
44
45
Sub CopieFichiers()
Dim source As String, destination As String, MaDate As String, Fichier As Variant
Dim Fso, DateFichier As String
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    'Définit le répertoire contenant les fichiers
    source = ThisWorkbook.Worksheets("Source répertoire").Range("B3").Value
    'Définit le répertoire de destination
    destination = ThisWorkbook.Worksheets("Source répertoire").Range("B4").Value
    MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(source & "*.csv")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")
 
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print source & Fichier
        DateFichier = Fso.GetFile(source & Fichier).DateCreated
        If DateFichier = MaDate Then
            Debug.Print Fichier
            'Code pour copier le fichier
 
 
ChDir source
 
Fichier = Application.GetOpenFilename(Title:="Sélection multiple", MultiSelect:=True)
 
If TypeName(Fichier) = "Boolean" Then
  Exit Sub
Else
  For I = 1 To UBound(Fichier)
    NomFichier = Mid(Fichier(I), InStrRev(Fichier(I), "\") + 1)
    FileCopy Fichier(I), destination14 & "\" & NomFichier
  Next
End If
 
            'FileCopy source & Fichier, destination & Fichier
        End If
        Fichier = Dir()
    Loop
    Set Fso = Nothing
End Sub

Cordialement,

Freudsw

05/05/2017, 10h02
Marc-L

Bonjour,

s'il s'agit d'ouvrir tous les fichiers d'une date précise alors la boite de dialogue est superfétatoire !

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Stockholm, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
05/05/2017, 10h11
Freudsw

Oui tu as raison, mais...

Bonjour Marc,

Effectivement, la boite de dialogue n'est pas necessaire vu qu'on va copier tous les fichiers, mais, le client veut avoir la main et visualier les fichiers qu'il copie, pour vérifier justement qu'il ne manque aucun fichier (Car vu que ces fichiers sont produits par une application quotidiennement, ça arrive des fois qu'elle ne produise pas tous les fichiers pour une raison ou un autre).

Cordialement,

Freudsw
05/05/2017, 10h24
Marc-L

Alors via une boucle utilisant la fonction VBA Dir (voir donc l'exemple dans l'aide VBA interne)
vérifier le critère de date de chaque fichier via la fonction VBA FileDateTime
- donc sans recourir à la librairie externe au VBA FileSystemObject -
afin de stocker les fichiers correspondant à ce critère soit dans une variable tableau soit dans une feuille de calculs
pour les afficher dans un UserForm (voir tutoriels disponibles sur ce forum) …
05/05/2017, 11h02
RyuAutodidacte

Bonjour,
Désolé, mais comme je suis super occupé, Je te réponds au mieux selon ma disponibilité.
Marc est du même avis pour l'utilisation de Dir comme je te l'ai conseillé.
Comme je te l'ai dit plus haut, il te fallait faire du pas à pas afin de vérifier les valeurs dans la fenêtre des variables locales pour corriger ce qui n'allait pas le cas échéant du fait que je n'ai pas eu le temps de tester le code.
Dans mon code tu as la base et le principe de ce qu'il faut faire.
Il te faut rajouter comme Marc te la conseillé le stockage soit dans une feuille soit dans une variable tableau.

Quels sont les valeurs de Source, Destination, et MaDate ?
05/05/2017, 11h12
Freudsw

Pas de soucis :)

Je suis entrain de me documenter, je ne suis pas un pro de VBA, je découvre les commandes que vous avez cité et j'essaye d'apprendre petit à petit.
Pour les valeurs que tu demandes, elles sont :
source : V:\UG\restitutions\00001CRC25
destination : N:\Projets01\TEST25
madate : c'est la date du jour soit 05/05/2017.

Cordialement,
05/05/2017, 11h49
RyuAutodidacte

Dans le cas où les chemins sont bons, il manque un anti slash à la fin de Source et Destination ,
donc soit les rajouter à la fin de chaque chemins soit l'incorporer dans le code, voir même avec une vérification, si le "\" est présent à la fin, dans le cas échéant le rajouter
Pour tester ton code mets la partie du code qui copie en commentaire et regarde le résultat du :
Debug.Print Fichier
dans la fenêtre d'exécution.
Afin de vérifier si les bon fichiers sont pris en compte

re,

toujours pas eu le temps de tester mais j'ai mis en commentaires les modifications,
j'ai désacticé FileCopy le temps que tu vérifies le résultat dans la fenêtre d'exécution :

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
Sub CopieFichiers()
Dim Source As String, Destination As String, MaDate As Date, Fichier As String, DateFichier As Date
'Dim Fso
 
    'Set Fso = CreateObject("Scripting.FileSystemObject")
 
    Source = ThisWorkbook.Worksheets("Source répertoire").Range("B3").Value
    If Right(Source, 1) > "\" Then Source = Source & "\" 'ajout de vérification
    Destination = ThisWorkbook.Worksheets("Source répertoire").Range("B4").Value
    If Right(Destination, 1) > "\" Then Destination = Destination & "\" 'ajout de vérification
    'MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value
    MaDate = Format(Now, "dd/mm/yyyy") 'la date Aujourd'hui peut s'écrire comme cela
 
    Fichier = Dir(Source & "*.csv")
 
    Do While Len(Fichier) > 0
        Debug.Print Source & Fichier
        'DateFichier = Fso.GetFile(Source & Fichier).DateCreated
        DateFichier = Format(FileDateTime(Source & Fichier), "dd/mm/yyyy")
        If DateFichier = MaDate Then
            Debug.Print Fichier
            'FileCopy Source & Fichier, Destination & Fichier
        End If
        Fichier = Dir()
    Loop
    'Set Fso = Nothing
End Sub

Edit : juste ne précision, à lire : https://msdn.microsoft.com/fr-fr/lib...(v=vs.90).aspx

05/05/2017, 14h38
Freudsw

ça fonctionne !!

ça fonctionne enfin !!merci beaucoup.

Par contre, maintenant il me reste à afficher le résultat dans une boite de dialogue afin que l'utilisateur puisse visualiser les fichiers qu'il doit copier.

Je pense à créer une variable tableau ou stocher le nom des fichiers et le visaliser par la suite avec un message demandant à l'utilisateur de confirmer son choix.

Cordialement,
05/05/2017, 14h55
RyuAutodidacte

As tu regardé la définition de FileDateTime ?
Car cela fait bien la date de création mais aussi de modification une fois le fichier modifié (et non plus de création alors), est ce bien cela que tu veux ?

Peut être que le mieux pour la suite est de visualiser les fichiers à copier dans une feuille afin de les valider … ?
05/05/2017, 14h59
Freudsw

Oui j'ai regardé la définition de FileDateTime et c'est exactement ce que je veux...

ça pourrait être une solution de les visualiser dans une feuille effectivement mais de façon temporaire....

Merci encore pour ton aide.

Cordialement,
05/05/2017, 15h13
RyuAutodidacte

Si tout est ok pour toi, alors mets en Résolu, sinon j'aurais un peu plus de temps ce week-end si besoin d'aide.

juste une dernière question :
as tu vérifié que tous les fichiers repertoriés sont à copier ou seulement qq uns ?

Bonjour,

Pour répondre à ta question : Oui tous les fichiers qui sont créés à la date d'aujourd'hui sont à copier.

Pour l'affichage de la liste des fichiers copiés, j'ai reussis à faire cet affichage mais ce n'est pas trés beau :
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 Sub CopieFichiers() Dim Source As String, Destination As String, MaDate As Date, Fichier As String, DateFichier As Date Dim ListeFichiers As String Source = ThisWorkbook.Worksheets("Source répertoire").Range("B13").Value Destination = ThisWorkbook.Worksheets("Source répertoire").Range("C13").Value MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value ' MaDate = Format(Now, "dd/mm/yyyy") 'la date Aujourd'hui peut s'écrire comme cela Fichier = Dir(Source & "*.csv") ListeFichiers = "" Do While Len(Fichier) > 0 Debug.Print Source & Fichier 'DateFichier = Fso.GetFile(Source & Fichier).DateCreated DateFichier = Format(FileDateTime(Source & Fichier), "dd/mm/yyyy") If DateFichier = MaDate Then Debug.Print Fichier FileCopy Source & Fichier, Destination & Fichier ListeFichiers = ListeFichiers & " " & Fichier & " " End If Fichier = Dir() Loop MsgBox "Ci-dessous la liste des fichiers copiés :" & ListeFichiers 'Set Fso = Nothing End Sub
J'ai stocké la liste des fichiers dans une variable ListeFichiers puis je l'affiche à la fin. Cependant, on ne lit pas trés bien dans cette fenêtre. Avez vous un moyen de mettre en forme cet affichage de telle sorte qu'on puisse lire facilement. Genre un affichage d'une liste comme ceci :

Ci-dessous la liste des fichiers copiés :
1. fichier1
2. fichier2
3. fichier3
4.ETC

Cordialement,

Freudsw

Bonjour,

Donc si tous les fichiers répertoriés sont à copier, normalement pas besoin de vérification, cependant voilà un exemple à adapter,
affichage à mettre sur une feuille temporaire (Attention les pointage ne sont pas fait) :
Code:

1 2 3 4 5 6 7 8 9 Sub Exemple() F1$ = "MonFichier1" F2$ = "MonFichier2" F3$ = "MonFichier3" F4$ = "MonFichier4" Fichiers = F1 & " | " & F2 & " | " & F3 & " | " & F4 MesFichiers = Split(Fichiers, " | ") Range("A1").Resize(UBound(MesFichiers) + 1) = Application.Transpose(MesFichiers) End Sub

Voir 40 message(s) de cette discussion en une page