Automaticaly save sheet in workbook every half hour.

brian5857

Board Regular
Joined
Jan 28, 2005
Messages
64
Does anyone have code to make a workbook automaticaly save itself every half hour. The workbook save as the current date and time. I have this code but it doesnt work sometimes for unknown reason...

Code in "This Workbook":
Private Sub Workbook_Open()

'Disable events
Application.EnableEvents = False

Resp = MsgBox("Do you want to automaticaly backup Production Reports every 30 minutes?", _
vbQuestion + vbYesNo, "Auto Backup")

If Resp = vbYes Then
' START BACKUP TIMERS
Application.OnTime TimeValue("00:00:00"), "DoBackup"
Application.OnTime TimeValue("00:30:00"), "DoBackup"
Application.OnTime TimeValue("01:00:00"), "DoBackup"
Application.OnTime TimeValue("01:30:00"), "DoBackup"
Application.OnTime TimeValue("02:00:00"), "DoBackup"
Application.OnTime TimeValue("02:30:00"), "DoBackup"
Application.OnTime TimeValue("03:00:00"), "DoBackup"
Application.OnTime TimeValue("03:30:00"), "DoBackup"
Application.OnTime TimeValue("04:00:00"), "DoBackup"
Application.OnTime TimeValue("04:30:00"), "DoBackup"
Application.OnTime TimeValue("05:00:00"), "DoBackup"
Application.OnTime TimeValue("05:30:00"), "DoBackup"
Application.OnTime TimeValue("06:00:00"), "DoBackup"
Application.OnTime TimeValue("06:30:00"), "DoBackup"
Application.OnTime TimeValue("07:00:00"), "DoBackup"
Application.OnTime TimeValue("07:30:00"), "DoBackup"
Application.OnTime TimeValue("08:00:00"), "DoBackup"
Application.OnTime TimeValue("08:30:00"), "DoBackup"
Application.OnTime TimeValue("09:00:00"), "DoBackup"
Application.OnTime TimeValue("09:30:00"), "DoBackup"
Application.OnTime TimeValue("10:00:00"), "DoBackup"
Application.OnTime TimeValue("10:30:00"), "DoBackup"
Application.OnTime TimeValue("11:00:00"), "DoBackup"
Application.OnTime TimeValue("11:30:00"), "DoBackup"
Application.OnTime TimeValue("12:00:00"), "DoBackup"
Application.OnTime TimeValue("12:30:00"), "DoBackup"
Application.OnTime TimeValue("13:00:00"), "DoBackup"
Application.OnTime TimeValue("13:30:00"), "DoBackup"
Application.OnTime TimeValue("14:00:00"), "DoBackup"
Application.OnTime TimeValue("14:30:00"), "DoBackup"
Application.OnTime TimeValue("15:00:00"), "DoBackup"
Application.OnTime TimeValue("15:30:00"), "DoBackup"
Application.OnTime TimeValue("16:00:00"), "DoBackup"
Application.OnTime TimeValue("16:30:00"), "DoBackup"
Application.OnTime TimeValue("17:00:00"), "DoBackup"
Application.OnTime TimeValue("17:30:00"), "DoBackup"
Application.OnTime TimeValue("18:00:00"), "DoBackup"
Application.OnTime TimeValue("18:30:00"), "DoBackup"
Application.OnTime TimeValue("19:00:00"), "DoBackup"
Application.OnTime TimeValue("19:30:00"), "DoBackup"
Application.OnTime TimeValue("20:00:00"), "DoBackup"
Application.OnTime TimeValue("20:30:00"), "DoBackup"
Application.OnTime TimeValue("21:00:00"), "DoBackup"
Application.OnTime TimeValue("21:30:00"), "DoBackup"
Application.OnTime TimeValue("22:00:00"), "DoBackup"
Application.OnTime TimeValue("22:30:00"), "DoBackup"
Application.OnTime TimeValue("23:00:00"), "DoBackup"
Application.OnTime TimeValue("23:30:00"), "DoBackup"
End If

'Disable events
Application.EnableEvents = True

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'Disable events
Application.EnableEvents = False

On Error GoTo TheEnd

' STOP BACKUP TIMERS
Application.OnTime EarliestTime:=TimeValue("00:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("00:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("01:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("01:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("02:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("02:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("03:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("03:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("04:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("04:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("05:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("05:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("06:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("06:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("07:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("07:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("08:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("08:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("09:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("09:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("10:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("10:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("11:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("11:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("12:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("12:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("13:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("13:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("14:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("14:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("15:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("15:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("16:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("16:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("17:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("17:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("18:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("18:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("19:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("19:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("20:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("20:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("21:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("21:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("22:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("22:30:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("23:00:00"), _
Procedure:="DoBackup", Schedule:=False
Application.OnTime EarliestTime:=TimeValue("23:30:00"), _
Procedure:="DoBackup", Schedule:=False

TheEnd:
'Disable events
Application.EnableEvents = True

End Sub



Code in Module "Backup":

Private Sub DoBackup()
' DO BACKUP
Path = "C:\Documents and Settings\PDC Maintenance\Desktop\Production Reports\"
Fname = Format(Date, "MM-DD-YY") & Format(Time, " hhmm") & " hrs" & ".xls"

ThisWorkbook.Sheets("Reports").Copy
ActiveWorkbook.SaveAs Filename:=Path & Fname

ActiveWindow.Close
End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

pfarmer

Well-known Member
Joined
Jul 6, 2005
Messages
550
Does anyone have code to make a workbook automaticaly save itself every half hour. The workbook save as the current date and time. I have this code but it doesnt work sometimes for unknown reason...

Code in "This Workbook":
Private Sub Workbook_Open()

'Disable events
Application.EnableEvents = False

Resp = MsgBox("Do you want to automaticaly backup Production Reports every 30 minutes?", _
vbQuestion + vbYesNo, "Auto Backup")

If Resp = vbYes Then
' START BACKUP TIMERS
Application.OnTime TimeValue("00:00:00"), "DoBackup"
Application.OnTime TimeValue("00:30:00"), "DoBackup"
Application.OnTime TimeValue("01:00:00"), "DoBackup"
Application.OnTime TimeValue("01:30:00"), "DoBackup"

Do you need to save the workbook every half hour or does it have to be on the half hour according to the clock?

Perry
 

brian5857

Board Regular
Joined
Jan 28, 2005
Messages
64
It doesnt have to be every hour hour mark on the clock. Just 30 min intervals would be OK also. The code I have does work . But, if the workbook is left running for a couple days it eventually stops saving itself for some unknown reason.
 

pfarmer

Well-known Member
Joined
Jul 6, 2005
Messages
550
It doesnt have to be every hour hour mark on the clock. Just 30 min intervals would be OK also. The code I have does work . But, if the workbook is left running for a couple days it eventually stops saving itself for some unknown reason.

Code:
Public SaveSheetTime As Double
Public Const SaveSheetIntervalSeconds = 1200
Public Const SaveSheetSub = "AutoSaveSheet"

Sub StartSaveSheetTimer()

SaveSheetTime = Now + TimeSerial(0, 0, SaveSheetIntervalSeconds)
Application.OnTime earliesttime:=SaveSheetTime, procedure:=SaveSheetSub, schedule:=True

End Sub

Sub AutoSaveSheet()

Dim wb As String

wb = ThisWorkbook.Name

If Workbooks(wb).ReadOnly Then Exit Sub

save_file_with_timestamp

StartSaveSheetTimer

End Sub

Sub StopTimers()

On Error Resume Next

Application.OnTime earliesttime:=SaveSheetTime, procedure:=SaveSheetSub, schedule:=False

End Sub

Sub StartTimers()

StartSaveSheetTimer

End Sub

Sub save_file_with_timestamp()

Dim filename, NewFilename As String
Dim Today

On Error GoTo EndMacro

Application.EnableEvents = False

filename = ThisWorkbook.Name

Today = Now

NewFilename = "Hour " & Hour(Today) & "." & filename

MyPath = Workbooks(filename).Worksheets("Setup").Range("c17")
MySaveString = MyPath & NewFilename

Workbooks(filename).SaveCopyAs MySaveString

EndMacro:

Application.EnableEvents = True

End Sub

This will save it with a time stamp every 1200 seconds.

Perry
 

Forum statistics

Threads
1,141,757
Messages
5,708,346
Members
421,566
Latest member
7Nabisco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top