Reputation: 59
Working on a test file that:
Issue
Workbook Module
Option Explicit
'https://stackoverflow.com/questions/46524488/how-to-save-an-excel-file-every-say-one-minute
'Following two code blocks + modAutoSave, autosaves the workbook every x seconds
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime saveTimer, "Save1", , False
Application.OnTime saveTimer, "Save2", , False 'Not sure if I need this?
End Sub
Private Sub Workbook_Open()
saveTimer = Now + TimeValue("00:01:00")
Application.OnTime saveTimer, "Save1"
Application.OnTime saveTimer, "Save2" 'Not sure if I need this?
End Sub
Userform Module
Option Explicit
Public Sub UserForm_Activate()
Dim i As Long
For i = 1 To 1000
With Me
.Label1.Caption = "Saving file..." & Format(i / 1000, "Percent")
.Show 'runtime error '-2147418105 automation error
.Show (False) 'needed to set Modal to False or form doesn't pop up
.Repaint 'shows image and label on userform, otherwise userform is blank
End With
saveTimer = Timer
Do
Loop While Timer - saveTimer < 0
DoEvents 'passes control to the operating system
If i = 1000 Then Unload Me
Next
End Sub
Regular Module
Sub Save1()
Dim fName As String 'workbook filename
Dim s As ufmAutoSave
Set s = New ufmAutoSave
fName = ThisWorkbook.Name & ".xlsm"
If ThisWorkbook.Name = fName Then
ThisWorkbook.Save
Call StatusBar
s.UserForm_Activate
Else
Call Save2
End If
saveTimer = Now + TimeValue("00:01:00")
Application.OnTime saveTimer, "Save1"
Sheets("Sheet1").[A1] = "Last saved: " & Format(Now, "mm-dd-yyyy hh:mm:ss AM/PM")
End Sub
Sub Save2()
Dim pathB As String 'path of Backup file
Dim bName As String 'workbook backup filename
Dim myDate As Long 'date backup workbook was last modified, must be As Long to avoid result 12/31/1899
Dim s As ufmAutoSave
Set s = New ufmAutoSave
pathB = "C:\Users\lritter\OneDrive - Carlisle Fluid Technologies\Desktop\Backup\"
bName = pathB & "myBackup.xlsm"
ThisWorkbook.SaveCopyAs Filename:=bName
ThisWorkbook.Save
Call StatusBar
s.UserForm_Activate
Application.OnTime saveTimer, "Save2"
myDate = LastModified
Sheets("Sheet1").[A2] = "Last backup: " & myDate & Format(Now, " mm-dd-yyyy hh:mm:ss AM/PM")
Sheets("Sheet1").[A3] = "Backup path: " & bName
End Sub
Function LastModified() As Date
LastModified = vbNull 'puts a "1" in front of the date & time result in cell A2?
'For example: "Last backup: 1 01-09-2025 03:38:35 PM"
If Len(Trim$(pathB)) = 0 Then Exit Function
With CreateObject("Scripting.FileSystemObject")
If .FileExists(pathB) Then LastModified = .GetFile(pathB).DateLastModified
End With
End Function
Sub StatusBar()
Dim i As Integer
For i = 1 To 1000
saveTimer = Timer
Do
Loop While Timer - saveTimer < 0
Application.StatusBar = "Saving file..." & Format(i / 1000, "Percent")
DoEvents 'passes control to the operating system
Next i
Application.StatusBar = False
End Sub
I am still very new to VBA, so I appreciate your help.
In the Userform module, I tried changing "With Me" and "Unload Me" to "With ufmAutoSave" and "Unload ufmAutoSave", per a recommendation I found online. However, if I use the form name, the form doesn't appear at all. So, Me = error, ufmAutoSave = userform doesn't show.
Upvotes: 0
Views: 25