Sujet Précédent Sujet Suivant

"macro excel création et effacement auto&quot

Résolu/Fermé
jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009 - 10 avril 2009 à 14:46
jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009 - 14 avril 2009 à 16:16
je suis ici :)
A voir également:

22 réponses

Précédent
  • 1
  • 2
Réponse 21 / 22
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
14 avril 2009 à 16:01
Alors je ne peux plus t'aider là dessus... Essaie un nouveau post en expliquant bien ton souci...
A+
0
Réponse 22 / 22
jah_haile_selassie Messages postés 60 Date d'inscription mardi 31 mars 2009 Statut Membre Dernière intervention 25 juin 2009
14 avril 2009 à 16:16
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
0