purger répertoire fichiers backup

[gfmout]

Bonsoir au forum,

J'ai récupéré sur ce forum un code permettant de faire une sauvegarde automatique du fichier
quand on ferme le fichier.

Voir code ci dessous...

J'aimerais savoir si on peut faire une modif pour purger le répertoire 'backup' automatiquement en ne gardant par exemple que les 30 derniers fichiers enregistrés dessus...

Ci quelqu'un à la solution, merci d'avance.

Gilles

Sub backup_file()
'
Dim vnomfichier As String
Dim vchemin As String
Dim strdate As String
strdate = Format(Date, 'dd-mm-yy-') & Format(Time, 'h-mm-ss')
vnomfichier = ('DATA')
vchemin = 'D:Mydocuments'
ChDir 'D:\\My Documents\\backup\\'
ActiveWorkbook.SaveCopyAs Filename:=vnomfichier + strdate + '.xls'
ActiveWorkbook.SaveCopyAs Filename:=vchemin + vnomfichier + strdate + '.xls'
End Sub

 

[Temjeh]

Bonjour à tous

Voici un début si tu peut t'en inspirer

Pour cela il doit d'abbord faire la liste des classeurs en col A (tu peut modifier cette colonne en col AA et à la fin du code supprimer les valeurs de col AA)et ensuite les tries et supprime ceux qui porte le nom de A31 et plus.
Il supprime 1 dir a toi de mettre ton 2ème.

ATTENTION il ne se mette pas dans la poubelle

Temjeh
[file name=Fait_Liste_delete_30.zip size=15405]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Fait_Liste_delete_30.zip[/file]

 

[Temjeh]

Oups prend celui-ci

Temjeh [file name=Fait_Liste_delete_30_20060408225450.zip size=16041]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Fait_Liste_delete_30_20060408225450.zip[/file]

 

[Temjeh]

Rebonsoir

Supprime les dates en col A elles ne servent pas.

Temjeh

Je vais dormir un peu(2 distraction en ligne)

Temjeh

 

[gfmout]

Bonsoir Temjeh!

ca m'a l'air ok ton histoire
Je vais mettre en place et reviens vers toi si soucis!!
je suis en déplacement semaine prochaine et je sais pas si j'aurais le temps de mettre en place.

Grand merci en tout cas

Gilles

 

[gfmout]

Salut Temjeh,

Je reviens vers toi après Un mois d'utilisation de la macro. J'espère que tu auras ce message!!

En fait j'ai un problème et peut être auras tu la solution ou l'explication?

J'ai en fait modifié ta macro pour que la purge se fasse directement à chaque fois sans à avoir à appuyer sur le bouton. Ca a marché pendant un temps mais depuis quelques temps, j'obtiens le message suivant quand la macro s'exécute.

Run Time error 53
File not found

Du coups le répertoire continue à grossir avec l'arrivée de nouveaux fichier et n'est plus purgé.

Ci joint le code de la macro backup avec la purge intégrée:

Sub backup_file()
'BACK UP DU FICHIER
'
Dim vnomfichier As String
Dim vchemin As String
Dim strdate As String
strdate = Format(Date, 'dd-mm-yy-') & Format(Time, 'h-mm-ss')
vnomfichier = ('Shop')
vchemin = 'D:Mydocuments'
ChDir 'D:\\My Documents\\backup\\'
ActiveWorkbook.SaveCopyAs Filename:=vnomfichier + strdate + '.xls'

'intégration purge au backup
Sheet20.Select
Dim r
r = Application.WorksheetFunction.CountA(Range('a1:a100'))
For i = 31 To r
Kill 'D:\\My Documents\\backup\\' & Range('A' & i).Value
Range('A' & i).Value = ''
Next i

Liste_filebackup
End Sub

Sub Liste_filebackup()
Dim TheFileSearcher
TheFileSearcher = 'D:\\My Documents\\backup'
Dim i As Integer
On Error Resume Next
Set TheFileSearcher = Application.FileSearch
With TheFileSearcher
.NewSearch
.Filename = '*.xls*'
.LookIn = 'D:\\My Documents\\backup'
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For i = 1 To .Count
Cells(i, 1).Value = ThePath & Dir(.Item(i))
Next i
End With
Else
MsgBox 'Pas de Fichier trouvéé dans ' & ThePath
End If
End With
Set TheFileSearcher = Nothing
'trie
Sheet20.Select
Columns('A:A').Select
Selection.Sort Key1:=Range('A1'), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Range('A1').Select
Sheet1.Select
End Sub

 

[gfmout]

Rebonjour,

je reviens vers toi car je pense avoir identifié le problème.

Tout d'abord La macro backup et purge est une macro événementielle qui s'execute quand on ferme le fichier.

Le message error est apparu alors que juste avant de fermer le fichier et après avoir exécuté la macro événementielle, à la question voulez vous enregister les modifications, j'ai une fois répondu 'non'.
Je crois que c'est ça qui a foutu le bordel dans la liste des fichiers backup.
Comment alors faire pour que ça n'arrive pas?
1/ Faire en sorte que l'ordinateur ne demande plus si on veut sauvegarder les modifications (c'est un peu dangereux non?)
2/ autre solution au niveau de ta macro pour refaire un tri mis à jour en début d'exécution?
Qu'en penses tu?

Mille merci d'avance

gilles