Sauvegarde automatique /30 min

Le 20/10/2022 à 23:43

Bonjour, je cherche à mettre en place une sauvegarde automatique toutes les 30 min, qui écraseraient au fur et à mesure celles de la veille.

Je suis tombé sur une discussion qui propose un code pour faire une sauvegarde quotidienne, qui écrase au fur et à mesure les sauvegardes de la semaine passée... Comment puis-je l'adapter à ma problématique svp ?

Private Sub Workbook_Open()
On Error Resume Next
Run "ZkVer"
'Autres instructions éventuelles...
End Sub

Private Sub ZkVer()
Dim Ext$, R$, Z$, S$, Y As Boolean
S = Day(Now) Mod 7
  R = ActiveWorkbook.Name: Ext = Right(R, Len(R) - InStr(R, ".") + 1)
  R = Left(R, InStr(R, ".") - 1)
Z = "D:SOS\" & R & S & Ext
Application.DisplayAlerts = False
If Len(Dir(Z)) = 0 Then
ActiveWorkbook.SaveCopyAs Z
Else
Y = CDate(Left(FileDateTime(Z), 10)) = Date
If Not Y Then ActiveWorkbook.SaveCopyAs Z
End If
Application.DisplayAlerts = Truee
End Sub
Le 20/10/2022 à 23:48

Bonsoir Arnnaud

Ce code n'est pas adaptable puisqu'il se lance à l'ouverture du classeur, il faudra utiliser un timer.

Mais je ne me lance pas la dedans, je ne vois pas l'intérêt d'une sauvegarde toutes les mn

Le 21/10/2022 à 00:33

bonjour Arnnaud, BrunoM45, le fil.

Le client est roi, des macros dans Thisworkbook et dans Module1, un copy chaque jour de la semaine.

15every30.xlsb (22.05 Ko)
Le 21/10/2022 à 03:48

Salut BsAlv,

Il n'y a pas de client ici... On ne fait payer personne (dommage)

Le 21/10/2022 à 04:24

sorry, pour ces mots blessants

Le 21/10/2022 à 07:43

Bonjour à tous,

Merci BsAlv, si je comprends bien ton code il fait un fichier par jour, qui est écrasé/renouvellé toutes les 30min, puis à la fin de la journée reste en l'état jusqu'à être écrasé la semaine suivante ?

Ce que j'aimerais c'est un dossier avec une sauvegarde par jour qui se renouvelle 1 fois par semaine au fil de l'eau (premier code avec sub ZkVer) mais en + un 2ème dossier avec les sauvegardes du jour toutes les 30 minutes mais qui se conservent toutes dans la journée. Par exemple "save_8h00.xls" ; "save_08h30.xls" etc, et le lendemain en faisant la même chose cela réécrit au fur et à mesure sur les différentes sauvegardes de la veille.

@BrunoM45 l'intérêt est qu'en cas de fausse manip dans la journée on peut retrouver ses données facilement. C'est le sens des sauvegardes automatiques d'excel mais qui je crois ne marchent pas avec l'utilisation des macros.

Le 21/10/2022 à 09:25

bonjour,

alors vous modifiez cette macro

Sub SaveCopyAs_30()
     '*******************************************************************************************
     'quand cette macro est exécuté, il prendra un backup dont le nom sera avec l'heure arrondi par exemple 09:23 sera 09:00
     'une fois par jour, il y aura aussi un backup par jour, la première fois que cette macro est parcouru ce jour
     '*******************************************************************************************

     Dim sp, sNom, sDemiHeure

     Stoppen

     'les demi-heures
     sp = Split(ActiveWorkbook.Name, ".")     'le nom de ce fichier
     sDemiHeure = Format(WorksheetFunction.Floor_Math(Now, 1 / 48), "\_hh\hmm\.")
     sNom = ThisWorkbook.Path & "\" & sp(0) & sDemiHeure & sp(1)     'ajouter demi-heure
     Application.DisplayAlerts = False
     ActiveWorkbook.SaveCopyAs sNom     'sauvegarde avec un copy chaque demi-heure
     Application.DisplayAlerts = True

     'les jours
     sNom = ThisWorkbook.Path & "\" & sp(0) & Format(Now, "\_dddd\.") & sp(1)    'ajouter jour de la semaine
     If Len(Dir(sNom)) = 0 Then
          ActiveWorkbook.SaveCopyAs sNom
     Else
          If Format(FileDateTime(sNom), "ddmmyy") <> Format(Now, "ddmmyy") Then ActiveWorkbook.SaveCopyAs sNom
     End If

     'la prochaine fois sera à ....
     dNext = WorksheetFunction.Floor_Math(Now + TimeSerial(0, 30, 1), 1 / 48)
     Application.OnTime dNext, "SaveCopyAs_30", , 1
End Sub
Le 21/10/2022 à 12:51

Wahou ça a l'air juste parfait, trop fort !

Un immense merci je trouve que dans mon cas c'est une sécurité qui est précieuse !

A+ encore merci!

Le 21/10/2022 à 13:07

Pour essayer de comprendre le fonctionnement, si je veux rajouter aussi une sauvegarde/mois par exemple un fichier janvier, un autre février etc

est-il correct de le faire ainsi :

     'les mois
     sNom = ThisWorkbook.Path & "\" & sp(0) & Format(Now, "\_mm\.") & sp(1)    
     If Len(Dir(sNom)) = 0 Then
          ActiveWorkbook.SaveCopyAs sNom
     Else
          If Format(FileDateTime(sNom), "mm") <> Format(Now, "mm") Then ActiveWorkbook.SaveCopyAs sNom
     End If

Merci

Le 21/10/2022 à 15:15

bonjour,

moi, je préfère aujouter "Octobre" au lieu de "10", mais les goûts et les couleurs ne se discutent pas ...

Puis vous avez le choix entre 2 options, le premier sauvegarde la première fois que cette macro est parcouru ce mois+année, le 2ième sauvegarde une fois chaque jour de ce mois+année, donc avec la première option vous aurez un backup du 3ième octobre par exemple, mais si vous utilisez ce fichier encore mille fois. La 2ième option vous donnera le sauvegarde au début du dernier jour que vous avez utilisé ce fichier, par exemple le 27 octobre.

c'est "mmyy" ou "ddmmyy" au lieu de votre "mm", autrement le jour suivant ou l'année suivante ne se passera rien

PS. je ne l'ai pas testé

'les mois

     sNom = ThisWorkbook.Path & "\" & sp(0) & "_" & WorksheetFunction.Proper(Format(Now, "mmmm\.")) & sp(1)  '---> moi, je préfère Mmm au lieu de mm, = "Jan" au lieu de "01"
     If Len(Dir(sNom)) = 0 Then
          ActiveWorkbook.SaveCopyAs sNom
     Else
          If Format(FileDateTime(sNom), "mmyy") <> Format(Now, "mmyy") Then ActiveWorkbook.SaveCopyAs sNom     '= la première fois de chaque mois
          If Format(FileDateTime(sNom), "ddmmyy") <> Format(Now, "ddmmyy") Then ActiveWorkbook.SaveCopyAs sNom     '= la première fois chaque jour de ce mois
     End If
Le 21/10/2022 à 15:40

bonjour,

for the fun ...

    'ISO_WEEK
     ww = WorksheetFunction.IsoWeekNum(Date)
     yy = Year(Date) + (ww = 1) * (Month(Date) = 12) - (ww > 50) * (Month(Date) = 1)
     sNom = ThisWorkbook.Path & "\" & sp(0) & "_Sem" & ww & "." & sp(1)  '---> moi, je préfère Mmm au lieu de mm, = "Jan" au lieu de "01"
     If Len(Dir(sNom)) = 0 Then
          ActiveWorkbook.SaveCopyAs sNom
     Else
          myDate = FileDateTime(sNom)
          ww0 = WorksheetFunction.IsoWeekNum(myDate)
          yy0 = Year(myDate) + (ww0 = 1) * (Month(myDate) = 12) - (ww0 > 50) * (Month(myDate) = 1)
          If yy & ww <> yy0 & ww0 Then ActiveWorkbook.SaveCopyAs sNom     '= backup début de la semaine
     End If
Le 21/10/2022 à 16:18

Rebonjour BsAlv, tout le monde,

Mettre "mmyy" est-ce que cela veut dire que l'année suivante cela en écrira un nouveau au lieu de réécrire sur ceux de l'année précédente ?

Et Iso_WEEK du dernier post que fait-il ?

J'avoue que j'ai du mal à bien suivre le fonctionnement de ces codes même si je trouve fantastique de pouvoir configurer ces choses aussi finement!

Le 21/10/2022 à 18:15

bonjour,

FileDateTime(sNom) vous donne la date & heure que ce fichier "sNom" est sauvegardé. Il faut comparer ce moment avec maintenant d'une manière qu'on a une réponse Vrai/Faux de ce qu'on veut savoir.

supposons le mois&année :

fichier est sauvegardé par exemple le 15/10/2022 15:22, alors format(filedatetime(sNom),"mmyy") sera "1022" parce que 10ième mois de 2022.

maintenant, c'est 21/10/2022 18:03, alors format(now,"mmyy") sera aussi "1022".

Les 2 sont egaux alors, il ne faut pas sauvegarder "SaveCopyAs"[s=fs-1.1][/s]

supposons jour

, on est Vendredi alors le fichier à vérifier est "C:\.....\MonFichier_Vendredi.xlsm"

Avec Format(FileDateTime(sNom), "ddmmyy"), on voit par exemple que le fichier est sauvegardé la semaine passée "14102022"

Aujourd'hui format(now,"ddmmyy") sera "211022"

Les 2 sont différent, alors il faut sauvegarder !

Rechercher des sujets similaires à "sauvegarde automatique min"