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\"