"macro excel création et effacement auto"
Résolu
jah_haile_selassie
Messages postés
60
Date d'inscription
Statut
Membre
Dernière intervention
-
jah_haile_selassie Messages postés 60 Date d'inscription Statut Membre Dernière intervention -
jah_haile_selassie Messages postés 60 Date d'inscription Statut Membre Dernière intervention -
je suis ici :)
A voir également:
- "macro excel création et effacement auto"
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Word et excel gratuit - Guide
- Liste déroulante excel - Guide
- Si et excel - Guide
- Creation compte gmail - Guide
22 réponses
Alors je ne peux plus t'aider là dessus... Essaie un nouveau post en expliquant bien ton souci...
A+
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
ç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