Automaticaly save sheet in workbook every half hour.

B

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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
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"
Click to expand...

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
 
Upvote 0
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.
 
Upvote 0
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.
Click to expand...

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
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Workbook with Timer Macro Saving After Closing
Replies
1
Views
416
John_w
J
L
  • Question
VBA to autosave and close after a set amount of time
Replies
1
Views
69
Anthony47
A
Sean15
  • Solved
Help with code forcing specific workbook to close after inactivity.
Replies
2
Views
483
Sean15
Sean15
S
  • Question
Running vba Application.OnTime TimeValue events in closed workbooks
Replies
1
Views
375
excel_learnerz
E
P
  • Question
Live Clock in a single cell
Replies
1
Views
523
DanteAmor
DanteAmor

Forum statistics

Threads
1,214,653
Messages
6,120,750
Members
448,989
Latest member
mariah3

Share this page

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
Back
Top