CODEWITHSUNDEEP
vbaexcel
mgunia
mgunia

Reputation: 147

Macro to make a backup while saving a file

I would like to have a macro which automatically makes the backup of my file to a different folder when it is being saved. I have found a working macro but it makes a copy each time when I run it (not automatically when file is being saved). Could anyone help me to amend the macro code to work as I described?

MACRO I HAVE:

Sub Auto_Save()

Dim savedate

savedate = Date

Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD - MM - YYYY")

Application.DisplayAlerts = False

Dim backupfolder As String
backupfolder = "Z:\My Documents\"
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder & " !"

End Sub

Upvotes: 2

Views: 39032

Answers (2)

Jack Geiger
Jack Geiger

Reputation: 115

Here's the code I created to backup my workbooks. It will create a subdirectory for your backups if it doesn't exist, and save backups to that directory.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False

    thisPath = ThisWorkbook.Path
    myName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".") - 1))
    ext = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, "."))
    backupdirectory = myName & " backups"

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not FSO.FolderExists(ThisWorkbook.Path & "/" & backupdirectory) Then
        FSO.CreateFolder (ThisWorkbook.Path & "/" & backupdirectory)
    End If

    T = Format(Now, "mmm dd yyyy hh mm ss")
    ThisWorkbook.SaveCopyAs thisPath & "\" & backupdirectory & "\" & myName & " " & T & "." & ext

    Application.EnableEvents = True
End Sub

Upvotes: 4

Olle Sjögren
Olle Sjögren

Reputation: 5385

You mean you just want one backup-file with the same name as the original? Just remove the date and time from filename of the backup copy:

ActiveWorkbook.SaveCopyAs Filename:=backupfolder & ActiveWorkbook.Name

You should also add some kind of error handling in case the backup file is open when trying to save etc.

EDIT (updated based on new input)

OK, then you need to trap an event. I've tried with the BeforeSave event and it works. There is also an AfterSave event you could try.

Add the following to the ThisWorkbook module:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim backupfolder As String

    backupfolder = "Z:\My Documents\"

    ThisWorkbook.SaveCopyAs Filename:=backupfolder & ThisWorkbook.Name
End Sub

Upvotes: 6

Related Questions