Discussion :

[Freudsw]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[RyuAutodidacte]

Re,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Debug.Print Source & Fichier

et que tu laisses en ligne 25:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 pour les posts qui t'ont été utiles

[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

[RyuAutodidacte]

Quellle est la ligne de code pour l'erreur ?
Le code tu l'active de quel manière ?

[Freudsw]

Le code est en erreur sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Cordialement,

Freudsw

[RyuAutodidacte]

en fait il faut ajouter une ligne, normalement se sera comme cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ??

[Freudsw]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.VBE.MainWindow.Visible = True

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

Cordialement,

Freudsw

[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.

[RyuAutodidacte]

Ok ça marche
Bonne continuation

[papamarc]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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