"macro excel création et effacement auto&quot - Page 2

Alors je ne peux plus t'aider là dessus... Essaie un nouveau post en expliquant bien ton souci...
A+

Pijaku Merci mec!
ça marche nikel!! j'ai testé et c'est bon. J'ai adapté la macro effacer que j'ai pris ailleurs et en plus j'ai enlever la création des sous dossiers pour l'obliger a effacer le contenu du dossier principal.

Donc pour recupituler j'arrive a effacer des fichier sauvegarder il y'a de cela trois jours. Et l'effcement se lance une seule fois! Merci encore mec :

Voici mon code complet:

Private Sub Workbook_Open() 'la macro s'exécute à l'ouverture du classeur
Dim Chemin, NomFic As String
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
NomFic = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".txt"
If Dir(Chemin & NomFic) = "" Then 'si le fichier de la date du jour n'existe pas
Call auto_open ' on lance l'effacement
Set FS = CreateObject("Scripting.FileSystemObject") 'on crée le fichier date du jour
Set a = FS.CreateTextFile(Chemin & NomFic, True)
a.Close
End If ' Il n'y a pas de sinon puisque si le fichier existe on ne fait rien
Call creation 'on appelle l'autre proc
End Sub

Sub auto_open()
Dim myFso, myFile, myFolder
Set myFso = CreateObject("Scripting.FileSystemObject")
'sélection du dossier à analyser
Set myFolder = myFso.GetFolder("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\")
'boucle sur tous les fichier du dossier
For Each myFile In myFolder.Files
'si la date de modification du fichier est antérieure à 3 jours, effacer le fichier
If DateDiff("d", myFile.DateLastModified, Now) > 2 Then myFile.Delete True
Next myFile
End Sub
------------------L'effacement-----------------
Sub auto_open()
Dim myFso, myFile, myFolder
Set myFso = CreateObject("Scripting.FileSystemObject")
'sélection du dossier à analyser
Set myFolder = myFso.GetFolder("\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\")
'boucle sur tous les fichier du dossier
For Each myFile In myFolder.Files
'si la date de modification du fichier est antérieure à 3 jours, effacer le fichier
If DateDiff("d", myFile.DateLastModified, Now) > 2 Then myFile.Delete True
Next myFile
End Sub
-----------------la création des fichiers-----------------
Sub creation()
Dim Chemin, fname As String 'jour
Chemin = "\\Ds-srv-hector\commun\DPAPH\Service Tarification\Sauvegarde temps réel\"
debut:
Start = Timer
intervalle = 60
Do While Timer < Start + intervalle
DoEvents ' laisse les autres applications
Loop
fname = "test- " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Hour(Time) & "H" & Minute(Time) & "m" & Second(Time) & "s" & ".xls"
ActiveWorkbook.SaveCopyAs Chemin & fname
GoTo debut
End Sub

Allez bonne soirée et a plus certainement