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

Version imprimable

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

Merci

Oui il n' y a pas besoin de vérifier la liste des fichiers mais comme je l'ai dit en haut, il se pourrait que l'application qui produit les fichiers ne fonctionnent pas et oublie de produire un fichier, donc le fait d'afficher les fichiers permettrait de s'assurer que l'application a bien produit tous les fichiers du jour.

C'est bon, J'ai reussi à fabriquer le bon code.

Merci bcp pour ton idée, ça m'a bien aidé ; j'ai converti la variable tableau en variable string qui m'a permis d'affichier le résultat.

Voici mon code final :

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 CopieFichiers()
 
'Déclaration des différentes variables
Dim Source As String, Destination As String, MaDate As Date, Fichier As String, DateFichier As Date
Dim ListeFichiers As String, i As Integer, strTablo As String
Dim MaListe As Variant
 
Source = ThisWorkbook.Worksheets("Source répertoire").Range("B13").Value  'Affectation à la variable "Source" à une cellule dans la feuille
Destination = ThisWorkbook.Worksheets("Source répertoire").Range("C13").Value 'Affectation à la variable "Destination" à une cellule dans la feuille
MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value 'Affectation à la variable "MaDate" à une cellule dans la feuille
   ' MaDate = Format(Now, "dd/mm/yyyy") 'la date Aujourd'hui peut s'écrire comme cela
 
 
Fichier = Dir(Source & "*.csv") 'Définition de la variable "Fichier", correspond à tous les fichiers qui ont une extension "csv" et qui se trouve dans le répertoire "Source"
 
ListeFichiers = "" 'Initialisation de la variable "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
            MaListe = Split(ListeFichiers, " | ")
     End If
     Fichier = Dir()
Loop
 
For i = 0 To UBound(MaListe)
strTablo = strTablo & Chr(10) & MaListe(i)
Next
MsgBox "Voici la liste des fichiers copiés :" & strTablo
 
End Sub

Merci encore.

Cordialement,

Freudsw

Re,

tu as remarqué que dans le code tu as laissé les "Debug.Print",
si tu enlèves en ligne 20 :

Code:

Debug.Print Source & Fichier

et que tu laisses en ligne 25:

Code:

Debug.Print Fichier

on peut virer les lignes 27-28 et 33 à 36
et on rajoute 2 lignes de code pour afficher l'ensemble des résultats dans la fenêtre d'exécution, cela donne :

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 CopieFichiers()
 
'Déclaration des différentes variables
Dim Source As String, Destination As String, MaDate As Date, Fichier As String, DateFichier As Date
Dim ListeFichiers As String, i As Integer, strTablo As String
Dim MaListe As Variant
 
Source = ThisWorkbook.Worksheets("Source répertoire").Range("B13").Value  'Affectation à la variable "Source" à une cellule dans la feuille
Destination = ThisWorkbook.Worksheets("Source répertoire").Range("C13").Value 'Affectation à la variable "Destination" à une cellule dans la feuille
MaDate = ThisWorkbook.Worksheets("Source répertoire").Range("C1").Value 'Affectation à la variable "MaDate" à une cellule dans la feuille
   ' MaDate = Format(Now, "dd/mm/yyyy") 'la date Aujourd'hui peut s'écrire comme cela
 
 
Fichier = Dir(Source & "*.csv") 'Définition de la variable "Fichier", correspond à tous les fichiers qui ont une extension "csv" et qui se trouve dans le répertoire "Source"
 
ListeFichiers = "" 'Initialisation de la variable "ListeFichiers"
 
Debug.Print "Voici la liste des fichiers copiés :"
 
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
 
Application.VBE.ActiveWindow.Collection("Exécution").Visible = True
 
End Sub

N'oublie pas de mettre des :plusser: pour les posts qui t'ont été utiles

09/05/2017, 14h07
Freudsw

J'ai testé ton code mais j'ai un message d'erreur "l'accés par programme au projet visual basic n'est pas fiable". c'est du à quoi ?

Cordialement,

Freudsw
09/05/2017, 14h09
RyuAutodidacte

Quellle est la ligne de code pour l'erreur ?
Le code tu l'active de quel manière ?
09/05/2017, 14h12
Freudsw

Le code est en erreur sur cette ligne :

Code:

Application.VBE.ActiveWindow.Collection("Exécution").Visible = True

Je l'active en appuyant sur le bouton "Exécuter sub/useform".

Cordialement,

Freudsw
09/05/2017, 14h19
RyuAutodidacte
en fait il faut ajouter une ligne, normalement se sera comme cela :
Code:

1 2 Application.VBE.MainWindow.Visible = True Application.VBE.ActiveWindow.Collection("Exécution").Visible = True
je suppose que le nombre de fichiers à copier ne dépasse pas le 50 ou 100 ??
09/05/2017, 14h26
Freudsw

Toujours le même message d'erreur, cependant il s'est déplacé sur cette ligne :

Code:

Application.VBE.MainWindow.Visible = True

Et oui, le nombre de fichier ne dépasse pas 20.

Cordialement,

Freudsw
09/05/2017, 14h39
Freudsw

J'ai trouvé ce qui posait probleme, c'était un probleme de sécurité .

Il fallait juste cocher une case comme suit :

Menu Office -> Options Excel -> Centre de gestion de la confidentialité -> Paramètres du Centre de gestion de la confidentialité -> Paramètres des macros -> Accèes approuvé au modèle d'objet du projet VBA.

Mais je prefere le premier type d'affichage.

Merci quand meme.

Cordialement,

freudsw.
09/05/2017, 14h43
RyuAutodidacte

Ok ça marche :ccool:
Bonne continuation ;)

1 pièce(s) jointe(s)

copier les fichiers plus récent qu'une date

Bonjour,

j'ai essayé d'adapter le code donné dans cette discussion pour mon besoin mais ca ne fonctionne pas comme il faut

il devrait normalement me copier que les fichiers qui sont plus récent qu'une date donné dans une cellule
Dans la situation actuelle il ne devrait me copier que le dernier fichier
mais j'obtient des copies qui sont pour moi incompréhensible
voila ce que j'ai

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
Dim Source As String, Destination As String, MaDate As String, Fichier1 As String
Dim Fso1, DateFichier1 As String
 
    Set Fso1 = CreateObject("Scripting.FileSystemObject")
 
    'Définit le répertoire contenant les fichiers
    Source = ("\\hugo\kalimnos\activite custo\j-m l\reunion fiche client\")
    'Définit le répertoire de destination
    Destination = ("\\hugo\kalimnos\ACTIVITE CUSTO\DEVIS APPAREILS\TRANSFERT SAP\reception fiche client\")
    MaDate = Range("AI2").Value
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier1 = Dir(Source & "*.xlsx")
 
    Do While Len(Fichier1) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print Source & Fichier1
        DateFichier1 = Fso1.GetFile(Source & Fichier1).DateCreated
        'DateFichier1 = Format(FileDateTime(Source & Fichier1), "dd/mm/yyyy")
 
        If DateFichier1 < MaDate Then
            Debug.Print Fichier1
 
            'Code pour copier le fichier
            FileCopy Source & Fichier1, Destination & Fichier1
 
        End If
 
        Fichier1 = Dir()
 
    Loop

Pièce jointe 596064

si quelqu'un voit l'erreur merci pour votre aide

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