Prompting to save at interval

[sriche01]

Hello all,

Is there a way to make a workbook require or remind a user to save at a set interval, say, every ten minutes? Didn't see it in options...
Thanks!

 

[Johnny C]

if you go into File, Excel options, save, there's an autorecover set by default for every 10 mins. You can change the options such as folder there.

 

[sriche01]

Thank you, but I have very little trust in auto recover. I would like a hard save every 10 min or so. Is there a macro that could be on a timer that would create a message box whose button saves the workbook?

 

[Johnny C]

I'm guessing you are using a recent version of Excel. it used to be able to autosave to the original location, but that got replaced with autorecover.

It is sort of possible. You need to have a cell where the time the last time it was saved can be recorded. Then in VBA, select the ThisWorkbook sheet and use

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    if (the time is 10mins after the time recorded) Then
       X=MsgBox ("Text to Display","VbYesNo")
       if X=VbYes Then 
          Activeworkbook.save
          (Set the time value in the cell you have chosen)
       End If
    End If
End Sub

Then every time you move a cell it will check the time and do what you need.

Unfortunately a timer won't work, as it would need to be a macro that ran non-stop and meant you couldn't access the workbook.

 

[sriche01]

Ok, just getting back to this project. Forgive my clumsy code - never had a lot of experience in VBA and what i did was mostly 5+ years ago. Ok, So here is my latest code try, building off your help

In a module:

Option Explicit
Private Sub workbook_OnOpen()


Dim basetime As Date
Set basetime = Now


End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim msg As Long
If ThisWorkbook.ReadOnly Then
Exit Sub
End If
   If (Now - basetime) > (10 / 1440) Then
   msg = MsgBox("It is time to save your work.  Save Now?", vbOKCancel, "Save your work!")
      If msg = vbOK Then
          ActiveWorkbook.Save
          Set basetime = ThisWorkbook.BuiltinDocumentProperties(12)
         
      ElseIf msg = vbCancel Then
          Set basetime = Now
      End If
    End If
End Sub

So the idea is, I want to have a message box appear prompting to save every ten minutes, or, the first time to come 10 minutes after opening the file. Ok would save and start a new 10 min interval. Cancel would reset the interval for another ten minutes out without saving. Opening in read only would void the sub.

The above code isn't working quite right and I'm guessing it involves the syntax or declarations or variables.

Help please from those who can write code (that works) in their sleep?

Thanks!

 

[PatOBrien198]

Make the "ThisWorkbook" object open event:

Private Sub Workbook_Open()
    StartSaveTimer
End Sub

In a code module copy the following...

If you want a quicker test, change the RunWhen to just 10 seconds... TimeValue("00:00:10")

Option Explicit
Dim RunWhen As Double

Sub StartSaveTimer()
    RunWhen = Now + TimeValue("00:10:00")
    Application.OnTime RunWhen, "AskToSave", , True
End Sub

Sub AskToSave()

Select Case _
MsgBox("Do you want to save?", vbYesNoCancel, "To save or not to save, that is the question.")
Case vbYes
    'your save code
Case vbCancel
    Exit Sub ' don't restart timer
Case Else
    'do nothing.
End Select
'restart the timer
   StartSaveTimer
End Sub

Sub CancelEarly()
    Application.OnTime RunWhen, "AskToSave", , False
End Sub

 

[sriche01]

Thank you for your help... it's got some bugs, or I didn't do it right.

I modified it slightly as per red text

Option Explicit
Dim RunWhen As Double


Sub StartSaveTimer()
    RunWhen = Now + TimeValue("00:[COLOR=#ff0000]01[/COLOR]:00")
    Application.OnTime RunWhen, "AskToSave", , True
End Sub


Sub AskToSave()


Select Case _
MsgBox("Do you want to save?", [COLOR=#ff0000]vbOKCancel[/COLOR], "To save or not to save, that is the question.")
Case [COLOR=#ff0000]vbOK[/COLOR]
    'your save code
[COLOR=#ff0000]    ThisWorkbook.Save[/COLOR]
[COLOR=#ff0000]    StartSaveTimer[/COLOR]
[COLOR=#ff0000]Case vbCancel[/COLOR]
[COLOR=#ff0000]    StartSaveTimer[/COLOR]
Case Else
    'do nothing.
End Select
'restart the timer
   StartSaveTimer
End Sub


Sub CancelEarly()
    Application.OnTime RunWhen, "AskToSave", , False
End Sub

Now it wants to pop up much more than just the minute interval specified. Almost constant.

Just to reiterate what I am looking for:

10 minutes after opening or last save a message box with an OK or cancel. Ok saves and resets the 10 minutes. Cancel gives it another 10 before asking again. Saving in between intervals should also refresh the timer. Also, when in read-only, no message box should appear.

Please Help! Thank you!

 

[PatOBrien198]

you added too many "StartSaveTimer" calls.

Either delete the one after the "End Select" or delete the two inside the "Select Case" block.

It looks like you want to have only two options... save or not, and if not, keep the timer going.


Try this... (remember to change the "TimeValue" interval to your desired length.....)

Option Explicit
Dim RunWhen As Double

Sub StartSaveTimer()
        RunWhen = Now + TimeValue("00:00:05")
        Application.OnTime RunWhen, "AskToSave", , True
End Sub

Sub AskToSave()
        If MsgBox("Do you want to save?", vbYesNo, "To save or not to save, that is the question.") = vbYes Then
            '  the after save event also re-starts the timer
            ThisWorkbook.Save
    Else
            StartSaveTimer
    End If
End Sub

Sub CancelEarly()
       On Error Resume Next
       Application.OnTime RunWhen, "AskToSave", , False
End Sub

then, also in the workbook object code:

Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
   
On Error Resume Next
   If Not IsNull(RunWhen) Then
            'cancel current timer
            CancelEarly
        
            'start new timer
            StartSaveTimer
    End If
End Sub

Private Sub Workbook_Open()
        If Not ActiveWorkbook.ReadOnly Then
                StartSaveTimer
    End If
End Sub

 

[sriche01]

Ok, I copied it exactly this time (other than changing the timer to 00:01:00) and I get an error saying variable not defined in the:

 If Not IsNull(RunWhen) Then

code in the After_Save Sub

 

[sriche01]

Ok fixed it. Just had to dim the variable on the workbook window as well.