VB Code to save a copy of the workbook as another name

[Ndel40]

I have an Excel 2007 workbook that tracks production data by shift. At the
end of the shift the operator runs a macro that saves the workbook as a new
name (date, time, shift, etc.) and then it reopens a template file that
immediately saves the template as a working file to be used for the new
shift. I have trained the operators to save the file every ½ hour to
prevent data loss and have the auto back-up set for every 5 minutes.
Everything works great until there is a power loss or the working file is
inadvertently closed. When this happens all of the current shift data is
lost because when a new template file is opened it creates the working file
which in turn overwrites the data. Also, because a new template file is
created the recovery file is no longer available.
My thought is if the file could be saved or copied automatically via VB code
every 10 minutes as a different name and in a different location and I could
recover the data.
For example: VB code in working file.xlsm runs every 10 minutes and copies
itself to a file called working file b-up.xlsx located in c:\1 and then
returns to working file.xlsm to continue to be used until the end of the
shift.
Here is what I have… the problem it does not return to the “working fileâ€.
Public RunWhen As Double
Public Const cRunIntervalSeconds = 120 ' two minutes
Public Const cRunWhat = "TheSub" ' the name of the procedure to run

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub

Sub TheSub()
Application.DisplayAlerts = False

ActiveWorkbook.SaveCopyAs Filename:="Electronic Workstation-testing.xlsm"

ActiveWorkbook.Close


StartTimer ' Reschedule the procedure

End Sub

Any help would be appreciated.

Thanks

 

[Dave Peterson]

It looks like all you need to do is remove that activeworkbook.close line (why
close it if you want to return to it).

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub

Sub TheSub()
dim myFileName as string

myfilename = "yourpath\elecWorkStation_" _
& format(now,yyyymmdd_hhmmss") & ".xlsm"

Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs Filename:=myfilename
StartTimer ' Reschedule the procedure

End Sub

It looks like you got this code from Chip Pearson's site.
http://www.cpearson.com/excel/OnTime.aspx

Remember to stop the timer when the workbook closes.

And I changed ActiveWorkbook to ThisWorkbook. I figured you wanted the workbook
with the code saved--not just any old workbook that happens to be active (my
football picks for this weekend's game may not be useful!).

 

[Ndel40]

Works great and yes I did borrow the idea from someone else (don't remember
if it was Chip)... I've never been afraid to steal a god idea… )

Thanks!