IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Supprimer les fichiers Excel plus vieux que 7 jours


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Inscrit en
    Avril 2006
    Messages
    48
    Détails du profil
    Informations forums :
    Inscription : Avril 2006
    Messages : 48
    Points : 24
    Points
    24
    Par défaut Supprimer les fichiers Excel plus vieux que 7 jours
    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

  2. #2
    Membre à l'essai
    Inscrit en
    Avril 2006
    Messages
    48
    Détails du profil
    Informations forums :
    Inscription : Avril 2006
    Messages : 48
    Points : 24
    Points
    24
    Par défaut
    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 :-)

  3. #3
    Inactif  
    Profil pro
    Inscrit en
    Juin 2007
    Messages
    2 054
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Juin 2007
    Messages : 2 054
    Points : 2 416
    Points
    2 416
    Par défaut
    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+

  4. #4
    Membre à l'essai
    Inscrit en
    Avril 2006
    Messages
    48
    Détails du profil
    Informations forums :
    Inscription : Avril 2006
    Messages : 48
    Points : 24
    Points
    24
    Par défaut
    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

  5. #5
    Membre à l'essai
    Inscrit en
    Avril 2006
    Messages
    48
    Détails du profil
    Informations forums :
    Inscription : Avril 2006
    Messages : 48
    Points : 24
    Points
    24
    Par défaut
    Citation Envoyé par LeForestier Voir le message
    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 ;-)

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. lftp et suppression de dossiers plus vieux que x jours
    Par krapo13 dans le forum Shell et commandes GNU
    Réponses: 5
    Dernier message: 06/09/2013, 15h04
  2. [Batch] supprimer les fichiers plus vieux que 10 jours
    Par big1 dans le forum Scripts/Batch
    Réponses: 4
    Dernier message: 11/09/2012, 11h50
  3. Réponses: 1
    Dernier message: 14/10/2011, 16h33
  4. [batch]supprimer les fichiers créés il y a X jour
    Par norac dans le forum Windows
    Réponses: 6
    Dernier message: 18/10/2006, 15h32

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo