Building Your Own (And Better) Autosave Feature for Excel

Have you ever been in that situation where you've been 'in the zone' for ages and then all of a sudden Excel crashes. You're just like 'Are... you... (*&^ing.. kidding me!'. Then you have this moment where, you're thinking 'Sure Excel Autosave is going to work this time! It never works but this time it just has to.' Excel opens back up and says "We've recovered some of your files" and then shows you that the last recovered time, is just the last time you actually saved it. "Hey we recovered your file just by going into your files and opening the last time you saved it. Ain't we clever!" NO EXCEL, what the!! Really?!

Anyway, I know that is a bit of a brain dumping rant but I go through this enough to know that Excel Autosave WILL DESTROY YOUR SOUL. Maybe 1%.

And seeings as we can't use git for Excel VBA development, I finally got sick of losing code with zero notice.

To fix this I figured out how to run a job every x minutes in Excel that would simply ask the question "Jay! When did you last save? If it's too long ago, then I'm gonna prompt you to save your work. If it is AAAAGES ago then I am gonna force you to save your work!"

It is also a nice pattern on how to schedule jobs in your Excel. So you can also extend this code to do other things like 'Remind you to stand up, or take a walk or drink some water :)'. Maybe you need a job that sends an email that triggers your IFTTT that turns your office lights off at 6PM so you can go home to your family.

So below, if you copy the code in ThisWorkbook.bas to your ThisWorkbook object. Then create two new modules called Job and Functions and copy those code snippets in then things should work. They probably won't just work but they should get you started.

I've also allowed you to drop zzz into your terminal to turn Jobs off while you are writing code, because running jobs on an increment while you are in your IDE can be a pain. So please! remember this because it is one thing to be working in Excel and having a better AutoSave feature and another to be working in VBA IDE and having a better autosave feature. This one works best for working in your Excel worksheet.

I also use OneDrive for Business to back my files up to the cloud. You might not need to use my wbLocalPath function if you normally store your file locally to begin with. This function just converts a OneDrive for Business or sharepoint url back to your local C Drive path so that the vba actually knows where the workbook is so that it can check it's last saved time.

I'll add any improvements to this code later. It needs error handling for example but for now it works enough to be better than what you get from Excel Out of the Box.

Enjoy! :D

ThisWorkbook.bas

Option Explicit

Private Sub Workbook_Open()
  Call Job.KillAllJobs
  Call Job.TrackLastSavedAt
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
  Application.StatusBar = "Last Saved " & LastSavedTimeStamp
  Call Job.KillAllJobs
  Call Job.TrackLastSavedAt
End Sub

Job.bas

Option Explicit

Public subName As String
Public subInterval As Date
Public PauseJobs As Boolean

' You can schedule multiple jobs by passing the Call to ScheduleJob with the new name and interval

Sub zzz()
  Call TurnJobsOff
End Sub

Sub TurnJobsOff()
  Clear
  PauseJobs = True
  Debug.Print Now(); ": Jobs paused"
End Sub

Sub TurnJobsOn()
  Clear
  PauseJobs = False
  Debug.Print Now(); ": Jobs unpaused"
  
  'List all jobs to turn back on below.
  TrackLastSavedAt
End Sub

Sub TrackLastSavedAt()
  
  If ActiveWorkbook.Name = "PUT YOUR WORKBOOK NAME HERE.xlsm" Then
  
    Dim sLastSavedAt As String: sLastSavedAt = LastSavedTimeStamp
    Dim minutes As Integer: minutes = DateDiff("n", sLastSavedAt, Now())
    
    Application.ScreenUpdating = False
    
    subName = "TrackLastSavedAt"
    subInterval = Now + TimeValue("00:00:30")
    
    'DO THE STUFF FOR THE JOB HERE
    If PauseJobs Then Debug.Print Now(); ": Jobs last paused"
    If PauseJobs = False Then
      Debug.Print Now(); ": TrackLastSaved has been run."
      If minutes > 5 And minutes <= 10 Then
        Application.StatusBar = sLastSavedAt & " - Last Checked At: " & Now & " - !!! This is over " & minutes & " minutes ago !!!"
      ElseIf minutes > 10 And minutes <= 20 Then
        Application.StatusBar = sLastSavedAt & " - Last Checked At: " & Now & " - !!! This is over " & minutes & " minutes ago !!!"
        If minutes Mod 5 = 0 Then
          If MsgBox("This workbook hasn't been saved in " & minutes & " minutes! Do you want to save?", vbYesNo, "Save?") = vbYes Then ThisWorkbook.Save
        End If
      ElseIf minutes > 20 Then
        Application.StatusBar = sLastSavedAt & " - Last Checked At: " & Now & " - !!! This is over " & minutes & " minutes ago !!!"
        If minutes Mod 2 = 0 Then
          If MsgBox("This workbook hasn't been saved in " & minutes & " minutes! Do you want to save?", vbYesNo, "Save?") = vbYes Then ThisWorkbook.Save
        End If
      Else
        Application.StatusBar = sLastSavedAt & " - Last Checked At: " & Now
      End If
    End If
    '---------------------------------------------------------
    
    Application.ScreenUpdating = True
  
  End If
  
  If PauseJobs = False Then Call ScheduleJob(subName, subInterval)
End Sub


' =======================================================

Sub ScheduleJob(p As String, s As Date)
  If ActiveWorkbook.Name = "PUT YOUR WORKBOOK NAME HERE.xlsm" Then
    Application.OnTime _
      earliesttime:=s, _
      procedure:=p, _
      schedule:=True
  End If
End Sub

Sub KillAllJobs()
  If ActiveWorkbook.Name = "PUT YOUR WORKBOOK NAME HERE.xlsm" Then
    Call KillJob("TrackLastSavedAt")
    Application.StatusBar = False
  End If
End Sub

Sub KillJob(p As String)
  On Error Resume Next
  Application.OnTime _
    earliesttime:=Now, _
    procedure:=p, _
    schedule:=False
End Sub

Features.bas

Option Explicit

Function LastSavedTimeStamp() As String
  LastSavedTimeStamp = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
  ' Exclude Autosave!
  LastSavedTimeStamp = FileDateTime(wbLocalPath(ThisWorkbook))
End Function

Sub ShowLastSavedTimeStamp()
  Dim hours As Integer: hours = DateDiff("h", LastSavedTimeStamp, Now())
  Dim minutes As Integer: minutes = DateDiff("n", LastSavedTimeStamp, Now())
  Dim seconds As Integer: seconds = DateDiff("s", LastSavedTimeStamp, Now())
  MsgBox "This workbook was Last Saved at " & vbNewLine & LastSavedTimeStamp & " or " & hours & ":" & (minutes Mod 60) & ":" & (seconds Mod 60) & " ago"
End Sub


Function wbLocalPath(ByRef wb As Workbook) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath As String

  'Check if it looks like a OneDrive location
  If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'Replace forward slashes with back slashes
    wbLocalPath = Replace(wb.FullName, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 6
        'Debug.Print wbLocalPath
       wbLocalPath = Mid(wbLocalPath, InStr(wbLocalPath, "\") + 1)
        'Debug.Print wbLocalPath
    Next

      'Construct the name
    wbLocalPath = UserProfilePath & "\OneDrive - COMPANY NAME\" & wbLocalPath

  Else

    wbLocalPath = wb.FullName

  End If
  
  'Just do a quick print and check that the paths are working ok. You might need to change the `Ctr = 1 To 6` part to get the right number of '\'
  'Debug.Print "This Workbook.LocalPath is:"
  'Debug.Print wbLocalPath
  
End Function