Discussion :

[jeje00]

Bonsoir,

Dans mon code VBA, j'ai écrit une procédure (Sauvegarde_quotidienne()) qui enregistre quotidiennement mon fichier Excel dans un répertoire de sauvegarde. Jusque la tout va bien.

Maintenant, j'aimerais qu'en même temps de la sauvegarde, la macro supprime tous les fichiers Excel dont la date du fichier est supérieure a 7 jours (je veux garder que mes 7 derniers fichiers Excel en cas de problème que je n'aurais pas vu dans les 7 derniers jours)

Je connais kill pour supprimer, mais comment lister tous les fichiers, récupérer seulement les extensions .xls, parmi ceux-ci récupérer la date dans le nom de fichier, la comparer avec la date du jour et supprimer les anciens ?

Code :

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

1
2
3
4
5
6
7
8
9
10
'Code pour la sauvegarde
 
Public Sub Sauvegarde_quotidienne()
 
Dim Nom_fichier As String
 
Nom_fichier = "C:\sauvegardeXLS\" & Date$ & ".xls" 
ActiveWorkbook.SaveCopyAs (Nom_fichier)  'sauvegarde
 
End Sub

Merci

[jeje00]

Je pense pouvoir y arriver avec cette ligne qui boucle sur TOUS les fichiers xls :

Code :

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

Fichier = Dir(Chemin & "*.xls")]

C'est finalement ce qui me manquait ;-)

Je reviendrais donner la reponse une fois l'algo terminé pour les futurs interessés :-)

[LeForestier]

Bonjour,
Une piste..

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
Sub SuppFichier()
'lire les fichiers d'un répertoir
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim D As Date, TB
    D = DateSerial(Year(Date), Month(Date), Day(Date) + 7)
    Chemin = "C:\sauvegardeXLS" 'adapter au répertoir où sont situés les fichiers.
    Ext = "xls" 'adapter l'extension
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un bon fichier
            'ici tester le nom et pour pas se casser la tête avec des dates genre
            '1/1/2009 et 01/01/2009
            TB = Split(f1.Name, ".")
            If CDate(TB(0)) < D Then
            'J'ai pas bien compris ce que tu veux en faire ! le supprimer ou renommer ?
            'beh tu en fait ce que tu veux.e ce que l'ont veux
            End If
        End If
    Next
End Sub

A+

[jeje00]

Grace a une petite recherche sur le post de ucfoutu m'ayant permis de connaitre d'existence d'une fonction de bouclage sur les fichiers présent dans un répertoire :

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
Sub BoucleFichiers()    'Boucle sur fichiers récupéré de http://excel.developpez.com/faq/index.php?page=FichiersDir#BoucleFichiers
 
    Dim Chemin As String, Fichier As String
 
    'Définit le répertoire contenant les fichiers
    Chemin = "C:\sauvegardeXLS\"
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.xls")
 
    Do While Len(Fichier) > 0   
 
        Fichier = Left(Fichier, Len(Fichier) - 4) 'Pour enlever l'extension .xls
 
        If IsDate(Fichier) Then   'Test si nom fichier sans l'extension .xls est une date
            If CDate(Fichier) < (DateValue(Now() - 8)) Then   'Test la date du nom de fichier est plus vieille que 8 jours
                Kill Chemin & Fichier & ".xls"   'Supprime le fichier
            End If
        End If
        Fichier = Dir()
    Loop
 
 
End Sub

[jeje00]

Bonjour,
Une piste..

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
Sub SuppFichier()
'lire les fichiers d'un répertoir
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim D As Date, TB
    D = DateSerial(Year(Date), Month(Date), Day(Date) + 7)
    Chemin = "C:\sauvegardeXLS" 'adapter au répertoir où sont situés les fichiers.
    Ext = "xls" 'adapter l'extension
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un bon fichier
            'ici tester le nom et pour pas se casser la tête avec des dates genre
            '1/1/2009 et 01/01/2009
            TB = Split(f1.Name, ".")
            If CDate(TB(0)) < D Then
            'J'ai pas bien compris ce que tu veux en faire ! le supprimer ou renommer ?
            'beh tu en fait ce que tu veux.e ce que l'ont veux
            End If
        End If
    Next
End Sub

A+

Merci LeForestier, cependant pour la comprehension, c'est autre chose, j'en suis pas encore a un tel niveau de programmation ;-)