Copie de sauvegarde automatique avec timer

[bardesun]

bonjour,

je souhaite sauvegarder un classeur excel à intervalles réguliers en gardant le nom d'origine + la date et l'heure de la sauvegarde dans son nom dans un dossier dédié aux sauvegardes mais le classeur d'origine doit rester ouvert avec son nom initial

pour celà j'ai un bout de code dans un module !

"Sub macro1()

Application.DisplayAlerts = False

ActiveWorkbook.Save

'mémoriser le path du classeur
memPath = ThisWorkbook.FullName

Chemin = "\\V:\Dossiers_001\Test_01\"
strDate = Format(Now, "mmm-dd-yyyy hh-mm")
Lib = ActiveWorkbook.Name
Lib01 = Left(Lib, 6)
nom_fich = Lib01 & strDate

'nom_fich = "classeur_" & strDate
nom_sauv = Chemin & "_" & nom_fich

ActiveWorkbook.SaveAs Filename:=nom_sauv
'Suppression des macros dans la copie enregistrée
With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else: .VBComponents.Remove VBC
End If
Next VBC
End With


'ouvrir l'ancien classeur (celui d'avant l'"enregistrer sous")
Application.Workbooks.Open memPath

Application.DisplayAlerts = True

'fermer ce classeur (la copie)
ThisWorkbook.Close False

'ActiveWorkbook.Close

End Sub "

cette partie fonctionne bien seule

j'ai dans un autre module :
"Option Explicit
Dim Tps As Date

Sub Tempo()
'Programmation de l'évènement toutes les secondes
Tps = Now + TimeValue("00:02:00")
Application.OnTime Tps, "Tempo"
'Traitement
'Sheets(1).Range("A1").Value = Format(Now, "hh:nn:ss")
macro1
End Sub"

afin d'automatiser les enregistrements

et dans Workbook :
"Private Sub Workbook_Open()




Application.DisplayAlerts = False

'Tempo

Application.DisplayAlerts = True"

celà fonctionne la première fois, mais aux suivantes la version qui reste ouverte à l'écran et la première version sauvegardée

merci de vos conseils

bardesun

 

[camarchepas]

Re : Copie de sauvegarde automatique avec timer

Bonjour ,,regardes comme ceci pour la copie de sauvegarde :

Chemin à adapter

ThisWorkbook.SaveCopyAs "c:\temp\" & Replace(ThisWorkbook.Name, ".xlsm", "_" & Replace(Replace(Now(), "/", "_"), ":", "-") & ".xlsm")

 

[mapomme]

Re : Copie de sauvegarde automatique avec timer

Bonsoir bardesun, camarchepas,

Un essai dans le fichier joint. Le code est entièrement dans le module de ThisWorkbook.

 

[sioum]

Re : Copie de sauvegarde automatique avec timer

Bonsoir,
Merci beaucoup ma pomme ton fichier est vraiment super
j'aurais une demande supplémentaire, serait-il possible de supprimer les x plus anciennes copies ?
Merci,encore...

 

[mapomme]

Re : Copie de sauvegarde automatique avec timer

Bonsoir sioum,

[...] j'aurais une demande supplémentaire, serait-il possible de supprimer les x plus anciennes copies ? [...]

Un essai dans le fichier joint.

Une constante nommée PlusVieuxQueXXheures définit le seuil de suppression des anciennes sauvegardes. On supprime toutes les sauvegardes vieilles de PlusVieuxQueXXheures heures ou plus.

Exemple: PlusVieuxQueXXheures = 2.5 -> les sauvegardes âgées de deux heures et demi ou plus sont effacées ; PlusVieuxQueXXheures = 72 -> les sauvegardes âgées de 3 jours ou plus sont effacées.

Cette suppression se produit à l'ouverture du fichier et à la fermeture du fichier.