Excel help #26758476547635

  • Thread starter Deleted member 6694
  • Start date
Status
Not open for further replies.
D

Deleted member 6694

Guest
As I don't trust Excel own autosave feature as it's not 100% fail safe, I'm trying to create some VB code to autosave the workbook every 5 minutes to a backup folder and timestamp the filename. I can autosave it no problem by itself using some simple code and I can also save it as a timestamp no problem using some other VB code but not both together.

I got the codes below that I use so maybe they can be merged together or something completely different created. It's going to be simple but my limit of VB is just hacking, merging, editing other VB code rather than creating it fresh.

AUTOSAVE - http://www.ozgrid.com/forum/showthread.php?t=126722&p=484912#post484912

VB:

Code:
Public dTime As Date
 
Sub AutoSaveAs()
    dTime = Time + TimeValue("00:05:00")
    With Application
        .OnTime dTime, "AutoSaveAs"
        .EnableEvents = False
        .DisplayAlerts = False
        ThisWorkbook.SaveAs "FilePath&NameHere(no .xls)"
        .EnableEvents = True
    End With
End Sub

In ThisWorkbook Module;

VB:

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime dTime, "AutoSaveAs", , False
End Sub
 
Private Sub Workbook_Open()
    dTime = Time + TimeValue("00:05:00")
    Application.OnTime dTime, "AutoSaveAs"
End Sub

TIMESTAMP CODE - https://excelribbon.tips.net/T013195_Creating_a_Dated_Backup_File.html

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFilename
    End With
End Sub

This is one way I've tried when I merged the 2 together but it's not saving anything so hoping someone here can correct it rather than hoying this question on an excel forum.

VB:
Code:
Public dTime As Date
 
Sub AutoSaveAs()
    dTime = Time + TimeValue("00:05:00")

    Dim sFileName As String
    Dim sDateTime As String

With ThisWorkbook
        .OnTime dTime, "AutoSaveAs"
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFilename
End Sub

In ThisWorkbook Module;

VB:

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime dTime, "AutoSaveAs", , False
End Sub
 
Private Sub Workbook_Open()
    dTime = Time + TimeValue("00:05:00")
    Application.OnTime dTime, "AutoSaveAs"
End Sub
 


why not just press save every few minutes yourself.

autosave..
for the brave
the untrusting
the unwilling
the suspense
is oh so thrilling
my file
its there
get in
I survive
to work
on excel
once again
Aye I do that and save it now and then but I just did it earlier and Excel crashed. It hadn't saved it properly and couldn't recover the file plus the xlbs autosave file I found was over 90 mins old!

I'm starting to understand how it worked and I've managed to make the code smaller. It now saves and date stamp it after 1 minute (testing time for now) of opening the file but I'm struggling to get it to repeat due to the End with line. If I remove it then the code obviously doesn't work so I'm looking for the alternative to keep it ongoing rather than ending due to the End with so looking through pages like this.

http://www.wiseowl.co.uk/blog/s193/do-until-while-loop.htm

This is the code I've got so far which is pretty basic stuff but the End with is the problem.

ThisWorkbook
Code:
Private Sub Workbook_Open()
   Application.OnTime Now + TimeValue("00:01:00"), "SaveWb"
End Sub

Module
Code:
Sub SaveWb()

    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
    sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFileName
    End With
      
    Application.OnTime Now + TimeValue("00:01:00"), "SaveWb"
  
End Sub
 
As I don't trust Excel own autosave feature as it's not 100% fail safe, I'm trying to create some VB code to autosave the workbook every 5 minutes to a backup folder and timestamp the filename. I can autosave it no problem by itself using some simple code and I can also save it as a timestamp no problem using some other VB code but not both together.

I got the codes below that I use so maybe they can be merged together or something completely different created. It's going to be simple but my limit of VB is just hacking, merging, editing other VB code rather than creating it fresh.

AUTOSAVE - http://www.ozgrid.com/forum/showthread.php?t=126722&p=484912#post484912

VB:

Code:
Public dTime As Date
 
Sub AutoSaveAs()
    dTime = Time + TimeValue("00:05:00")
    With Application
        .OnTime dTime, "AutoSaveAs"
        .EnableEvents = False
        .DisplayAlerts = False
        ThisWorkbook.SaveAs "FilePath&NameHere(no .xls)"
        .EnableEvents = True
    End With
End Sub

In ThisWorkbook Module;

VB:

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime dTime, "AutoSaveAs", , False
End Sub
 
Private Sub Workbook_Open()
    dTime = Time + TimeValue("00:05:00")
    Application.OnTime dTime, "AutoSaveAs"
End Sub

TIMESTAMP CODE - https://excelribbon.tips.net/T013195_Creating_a_Dated_Backup_File.html

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFilename
    End With
End Sub

This is one way I've tried when I merged the 2 together but it's not saving anything so hoping someone here can correct it rather than hoying this question on an excel forum.

VB:
Code:
Public dTime As Date
 
Sub AutoSaveAs()
    dTime = Time + TimeValue("00:05:00")

    Dim sFileName As String
    Dim sDateTime As String

With ThisWorkbook
        .OnTime dTime, "AutoSaveAs"
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFilename
End Sub

In ThisWorkbook Module;

VB:

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime dTime, "AutoSaveAs", , False
End Sub
 
Private Sub Workbook_Open()
    dTime = Time + TimeValue("00:05:00")
    Application.OnTime dTime, "AutoSaveAs"
End Sub
Have you tried, I don't know, just saving the file you're working on every five to ten minutes yourself, instead of going to all of this trouble?
 
:EDIT: The above code actually works after I saved, closed and re-opened the file :cool: Just need to suss out how to get it to save in a backup folder rather than the original folder location to keep things tidy.

Have you tried, I don't know, just saving the file you're working on every five to ten minutes yourself, instead of going to all of this trouble?
See a couple of posts above as I do this and have for years now but it still can fail. I have an icon to save the file and click it now and then but had been working on something for a while so hadn't saved it recently. When I did then clicked save it crashed and couldn't recover the file!

This 'simple' bit of code saves the file every X mins and timestamps it so even if the original corrupts there will be a trail of timestamped backups depending on the time I hoy in. Also this means if something knacks further down the line, I have the old backup files I can refer to if I want to replace/correct stuff. I want this as it's another sickener when you later realise changes you made a while/days back knacked something and saving backups manually after every revision, no matter how small, is a chore.
 
Last edited by a moderator:
Try changing:

Code:
sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
.SaveCopyAs sFilename

To:

Code:
sBakPath = .Path & "\BAK\"
sFileName = Application.WorksheetFunction.Substitute _
          (.Name, ".xlsm", sDateTime)
.SaveCopyAs sBakPath & sFilename

Typed in without testing.....
 
:EDIT: The above code actually works after I saved, closed and re-opened the file :cool: Just need to suss out how to get it to save in a backup folder rather than the original folder location to keep things tidy.


See a couple of posts above as I do this and have for years now but it still can fail. I have an icon to save the file and click it now and then but had been working on something for a while so hadn't saved it recently. When I did then clicked save it crashed and couldn't recover the file!

This 'simple' bit of code saves the file every X mins and timestamps it so even if the original corrupts there will be a trail of timestamped backups depending on the time I hoy in. Also this means if something knacks further down the line, I have the old backup files I can refer to if I want to replace/correct stuff. I want this as it's another sickener when you later realise changes you made a while/days back knacked something and saving backups manually after every revision, no matter how small, is a chore.
Save it to Dropbox. It has versioning control. It fucks up, you roll back a version or two
 
Save it to Dropbox. It has versioning control. It fucks up, you roll back a version or two
Ta for suggestion but it's not what I'd want for this situation (handy to know though as I may use that instead of Google Drive for other stuff) and I doubt it would work when I'm offline. The way it works now is nearly perfect for my needs as it makes backups every X amount of mins. I just need to get it to save the file to the BACKUP folder rather than the same folder that the master file is located. It's a simple edit of code above as I've done it before but the backup was only created every time you manually saved it and not every X minutes.
 
Status
Not open for further replies.

Back
Top