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