I can't get an autosave macro to save a workbook to my PC every 10 minutes

[Divadog]

I need help to get the appended Excel macro to work. The macro should back up the active workbook to a folder on one of my hard drives every ten minutes. Each save should have a different file name. I don't want to use the Microsoft Excel autorecover feature as I don't trust the cloud in any way. Also, I'm making a lot of edits where errors may not be apparent for quite a while. I may need to redo 30 minutes of editing.

i cobbled this macro together from various Excel autosave macros I found on the Internet. The macro will run, but it is not saving the workbook. No error is given. I cannot determine what code is failing to make the save statement(s) run.

I would be very grateful to any forum member who can correct my code.

Also, fairly often I leave my workbooks open for quite a while but do no work on them. So, during these 'down' periods there is no need to for automatic backups: The workbook is unchanged. I only want to have a backup when I have made changes to a workbook.

So, I'm looking for a line(s) of code that would only execute an automatic save when I resume working on it. Kind of like a WORKBOOKISACTIVE function (I doubt if there is one) that could go in an if statement:

IF WORKBOOKISACTIVE then
. . . start countdown for savings the workbook after 10 minutes has elapsed.

My thanks in advance for your help and suggestions.

Here is my macro:

Private Sub StartTimer()
    Dim SavedFileVersion As Integer
    SavedFileVersion = 0 'Set File version number to 0
    m_dtNextTime = Now + m_dtInterval
    Application.OnTime m_dtNextTime, "MacroName"
End Sub

Public Sub MacroName()
    On Error GoTo ErrHandler:   
    Dim StrPath As String
    Dim StrExt As String
    Dim NewFileName As String
    Dim Interval As Integer
    Dim SavedFileVersion As String    
    SavedFileVersion = SavedFileVersion + 1 'increase the file name version number by 1
    StrPath = "H:\Miscellaneous\Computing\Excel AutoSave Spreadsheets" 'Folder to save workbook
    StrExt = CStr(SavedFileVersion) & ".xlsm" 'Workbook extension
    NewFileName = StrPath & StrExt 'Workbook file name    
    StartTimer
    Exit Sub
    ErrHandler:
    ' Handle errors, restart timer if desired
End Sub

Public Sub Disable()
    On Error Resume Next ' Ignore errors
    Dim dtZero As Date
    If m_dtNextTime <> dtZero Then
        ' Stop timer if it is running
        Application.OnTime m_dtNextTime, "MacroName", , False
        m_dtNextTime = dtZero
    End If
    m_dtInterval = dtZero
End Sub

[Aflatoon]

Where is the variable m_dtNextTime declared?
The variable for Savefileversion needs to be declared either public or module level, not in any procedures, or you will always be saving the workbook as #1.

[Divadog]

Thanks for the help. I very much appreciate it.

I see your point about SaveFileVersion, but I'm unsure

1. In which macro I should declare it: MacroName or Disable
2. In either case I think I need to initialize its value to zero
3. And then increase its value by 1 every time the workbook is saved
4. But since the overall macro is looping through both MacroName and Disable every ten minutes won't SaveFileVersion always be reinitialized as 0 and then increased to a value of 1? Will I then always be saving the workbook as #1?

If my interpretation is correct how can I get around this problem. I very much welcome your thoughts.

[Aussiebear]

Maybe try this?

Private Sub Workbook_Open()
    ' Start the autosave timer when the workbook open
    Call StartAutoSave
 End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Stop the autosave timer when the workbook closes
    Call StopAutoSave
End Sub

Sub StartAutoSave()
    ' Set the timer to run the AutoSave procedure every 10 minutes (600,000 milliseconds)
    Application.OnTime Now + TimeValue("00:10:00"), "AutoSave"
End Sub

Sub StopAutoSave()
    ' Clear the timer
    On Error Resume Next 
    ' In case the timer isn't running
    Application.OnTime EarliestTime:=Now + TimeValue("00:10:00"), _
    Procedure:="AutoSave", Schedule:=False
    On Error GoTo 0
End Sub

Sub AutoSave()
    ' Save the active workbook
    ThisWorkbook.Save
    ' Restart the timer
    Call StartAutoSave
End Sub

[Aussiebear]

Then if you want to autosave with incremental version

Sub AutoSaveIncremental()
    ' Declare variables
    Dim NextSaveTime As Date
    Dim SaveCount As Integer
    Dim SaveName As String
    Dim BaseName As String
    Dim FilePath As String
    ' Initialize variables
    SaveCount = 1
    NextSaveTime = Now + TimeValue("00:10:00") 
    ' 10 minutes from now
    BaseName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) 
    ' Get the base name without extension
    FilePath = ActiveWorkbook.Path & "\" 
    ' Get the path
    ' Main loop
    Do While True
        ' Check if it's time to save
        If Now >= NextSaveTime Then
            ' Construct the save name
            SaveName = FilePath & BaseName & " " & Format(SaveCount, "00") & ".xlsx" ' or .xlsm if macros are enabled
            ' Save the workbook
            ActiveWorkbook.SaveCopyAs SaveName
            ' Increment the save count
            SaveCount = SaveCount + 1            
            Set the next save time
            NextSaveTime = Now + TimeValue("00:10:00")
        End If
        ' Allow other processes to run
        DoEvents
    Loop
End Sub

Sub StopAutoSaveIncremental()
    ' this sub is just to stop the autosave sub, by ending the loop.
    End
End Sub

' Example of how to start the autosave from the immediate window or another sub:
' Call AutoSaveIncremental
' And stop it with:
' Call StopAutoSaveIncremental

[Aflatoon]

1. In which macro I should declare it: MacroName or Disable

Neither. As I said, it should not be in any procedure. It should be declared at the top of the relevant module, possible as Public depending on which modules these codes are in.

2. In either case I think I need to initialize its value to zero

Its value will be 0 when the workbook opens by default.

3. And then increase its value by 1 every time the workbook is saved

Correct

4. But since the overall macro is looping through both MacroName and Disable every ten minutes won't SaveFileVersion always be reinitialized as 0 and then increased to a value of 1?

No, see point 2.

However, I have just noticed that you don't have any code to actually save the workbook...

Also, if you want to check if the workbook has actually been changed, you can check its Saved property.


If my interpretation is correct how can I get around this problem. I very much welcome your thoughts.[/QUOTE]

[Divadog]

Thanks so much. Your code is running without a problem.

However, I needed to make one final change to it, but unfortunately have not been successful.

Presently, your code saves the workbook to the folder it was opened from. Instead, I want all my workbook incremental backups to go to the same folder: H:\Miscellaneous\Computing\Excel AutoSave Spreadsheets\

So I changed your code, FilePath = ActiveWorkbook.Path & "" to: FilePath = "H:\Miscellaneous\Computing\Excel AutoSave Spreadsheets"

Unfortunately, the macro is now failing to run and I can't figure out why. I don't know if I accidently made any other changes to your code that could have compromised the macro. Anyway, here is the AutoSaveIncremental macro as it is now running:

Sub AutoSaveIncremental()
   ' Declare variables
    Dim NextSaveTime As Date
    Dim SaveCount As Integer
    Dim SaveName As String
    Dim BaseName As String
    Dim FilePath As String
    ' Initialize variables
    SaveCount = 1
    NextSaveTime = Now + TimeValue("00:10:00")
    ' 10 minutes from now
    BaseName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    ' Get the base name without extension
    ' FilePath = ActiveWorkbook.Path & ""
    FilePath = "H:\Miscellaneous\Computing\Excel AutoSave Spreadsheets" 'Folder to save workbook
    ' Get the path
    ' Main loop
    Do While True
        ' Check if it's time to save
        If Now >= NextSaveTime Then
            ' Construct the save name
            SaveName = FilePath & BaseName & " " & Format(SaveCount, "00") & ".xlsx" ' or .xlsm if macros are enabled
            ' Save the workbook
            ActiveWorkbook.SaveCopyAs SaveName
            ' Increment the save count
            SaveCount = SaveCount + 1 'Set the next save time
            NextSaveTime = Now + TimeValue("00:10:00")
        End If
        ' Allow other processes to run
        DoEvents
    Loop
End Sub

If you could this final fix, I would be very grateful indeed.

[Paul_Hossler]

Try adding a backslash at the end of FilePath

FilePath = "H:\Miscellaneous\Computing\Excel AutoSave Spreadsheets\"