VBA backup routine (save copy) with Excel 2010

[excelstarter1]

Hey guys,

I coded the following backup routine in VBA last month and just when I needed one of those (presumably working) backup files I noticed the error I made... Stupid rookie mistake I guess.

Basically the code was intended to save a copy of the active workbook with a time/date stamp in a folder called 'Backup'. However, up until now, I did not know, that I cannot force the fileformat when using the command ActiveWorkbook.SaveCopyAs.

I am running Excel 2010, maybe the issue is solved in newer versions of Excel. Anyways, it would be great if a more experienced board user could help me out with this and revise the code. Thinking about it I dont want to force the file format 'xlsx' but instead I just want to keep the original file format (xls, xlsm, csv, ...) and add the time stamp to the original workbook when saving.

Thank you very much in advance!!

Regards

Option Explicit

Sub Create_Backup()

Dim wkbname As String, wkbpath As String, filenm As String

Application.DisplayAlerts = True

wkbname = ActiveWorkbook.Name
wkbpath = ActiveWorkbook.Path
filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(wkbname)

If Dir(wkbpath & "\" & "Backup", vbDirectory) = "" Then 'check if Backup folder already exists, if not > create folder

    If MsgBox("The folder or path " & vbNewLine & vbNewLine & wkbpath & "\" & "Backup" & vbNewLine & vbNewLine & "does not exist." & vbNewLine & vbNewLine & _
         "Want to create the backup folder?", (vbYesNo)) = vbNo Then Exit Sub

        MkDir wkbpath & "\" & "Backup"
        ActiveWorkbook.SaveCopyAs Filename:=wkbpath & "\" & "Backup" & "\" & filenm & "_" & Format(Now, "yyyy-mm-dd_hh-mm") & ".xlsx"

    Else

    ActiveWorkbook.SaveCopyAs Filename:=wkbpath & "\" & "Backup" & "\" & filenm & "_" & Format(Now, "yyyy-mm-dd_hh-mm") & ".xlsx"

End If

CreateObject("WScript.Shell").Popup "Auto backup created", 1, "Backup"
    
End Sub

 

[dmt32]

Hi,
try this update to your code & see if does what you want

Sub Create_Backup()


    Dim FolderPath As String, FileExt As String
    Dim FullFileName As String, msg As String
    Dim Response As VbMsgBoxResult
    Dim FileName As Variant
    
    FolderPath = ActiveWorkbook.Path & "\Backup"
    FileName = Split(ActiveWorkbook.Name, ".")
    FileExt = FileName(1)
    FullFileName = FolderPath & "\" & _
                   FileName(0) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & "." & FileName(1)
                   
    msg = "The folder or path " & vbNewLine & vbNewLine & _
            FolderPath & vbNewLine & vbNewLine & _
            "does not exist." & vbNewLine & vbNewLine & _
            "Want to create the backup folder?"
                
    
'check if Backup folder already exists
    If Dir(FolderPath, vbDirectory) = vbNullString Then
'if not ask user to create folder
    Response = MsgBox(msg, 36, "Folder Not Found")
         If Response = vbYes Then MkDir FolderPath Else Exit Sub
    End If
    
    ActiveWorkbook.SaveCopyAs FileName:=FullFileName


    MsgBox "Auto backup created", 48, "Backup"
End Sub

Dave

 

[excelstarter1]

Hi Dave, thank you very much!!
I will try it out and let you know.

Two remarks:
(1) what if the workbook name includes a "." such as "My.Workbook.New.xlsx" >

FileName = Split(ActiveWorkbook.Name, ".")

(2) The problem I had was, that I was able to save a copy of the file with the "ActiveWorkbook.SaveCopyAs" method and with my file extension / format, however, when I tried to open the file later, I got an error message and Excel was not able to read the file. Did you experience the same issues?

Thanks!!

Regards

 

[dmt32]

Hi,
I never anticipated such a naming convention

Try this update to code

Sub Create_Backup()
    
    Dim FolderPath As String, FileExt As String
    Dim FullFileName As String, msg As String
    Dim Response As VbMsgBoxResult
    Dim FileName As Variant
    
    With ActiveWorkbook
'folder path
        FolderPath = .Path & "\Backup"
'file ext
        FileExt = Right$(.Name, Len(.Name) - InStrRev(.Name, "."))
'filename no ext
        FileName = Left(.Name, Len(.Name) - Len(FileExt) - 1)
    End With
    
    FullFileName = FolderPath & "\" & _
    FileName & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & "." & FileExt
    
    msg = "The folder or path " & vbNewLine & vbNewLine & _
    FolderPath & vbNewLine & vbNewLine & _
    "does not exist." & vbNewLine & vbNewLine & _
    "Want to create the backup folder?"
    
    
'check if Backup folder already exists
    If Dir(FolderPath, vbDirectory) = vbNullString Then
'if not ask user to create folder
        Response = MsgBox(msg, 36, "Folder Not Found")
        If Response = vbYes Then MkDir FolderPath Else Exit Sub
    End If
    
    ActiveWorkbook.SaveCopyAs FileName:=FullFileName
    
    MsgBox "Auto backup created", 48, "Backup"
End Sub

Dave

 

[excelstarter1]

Great, Dave, thanks again!

It seems to be working :D

Just had one issue: when starting a new workbook without saving it first (so a temp file in the temp folder) I run into an error. Is there a way to check if the workbook was already saved once (in the designated folder) or is running in "temporary" mode? It is a minor issue, but I am curious.

 

[dmt32]

Hi,
you can test the workbooks path to determine if workbook has been saved

With ActiveWorkbook
    If .Path = "" Then Exit Sub

Add line shown in RED & see if does what you want.

Dave

 

[excelstarter1]

It did the trick. Awesome.
Thanks for your quick help!

 

[kelly mort]

Hello Dave,
I wanna do something similar to this but I want to call the Save As dialogue Box where I can choose location and file name myself. I want to save the file in the macro enabled format. Thanks
Kelly

 

[dmt32]

Hi,
This thread is concluded with OP - I would suggest that you start your own thread (with link to this one if relevant), you are likely to get more responses.

Dave

 

[kelly mort]

Hi,
I never anticipated such a naming convention

Try this update to code

Sub Create_Backup()
    
    Dim FolderPath As String, FileExt As String
    Dim FullFileName As String, msg As String
    Dim Response As VbMsgBoxResult
    Dim FileName As Variant
    
    With ActiveWorkbook
'folder path
        FolderPath = .Path & "\Backup"
'file ext
        FileExt = Right$(.Name, Len(.Name) - InStrRev(.Name, "."))
'filename no ext
        FileName = Left(.Name, Len(.Name) - Len(FileExt) - 1)
    End With
    
    FullFileName = FolderPath & "\" & _
    FileName & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & "." & FileExt
    
    msg = "The folder or path " & vbNewLine & vbNewLine & _
    FolderPath & vbNewLine & vbNewLine & _
    "does not exist." & vbNewLine & vbNewLine & _
    "Want to create the backup folder?"
    
    
'check if Backup folder already exists
    If Dir(FolderPath, vbDirectory) = vbNullString Then
'if not ask user to create folder
        Response = MsgBox(msg, 36, "Folder Not Found")
        If Response = vbYes Then MkDir FolderPath Else Exit Sub
    End If
    
    ActiveWorkbook.SaveCopyAs FileName:=FullFileName
    
    MsgBox "Auto backup created", 48, "Backup"
End Sub

Dave

I don't really understand this code but maybe it may be close to what I wanted. It is like this:
I want to create a new workbook from the current workbook I am working on. So when I call this macro, I should create a copy to be saved as, close the original workbook then I have a macro that will clear certain range of the newly created workbook 's sheets. I am a bit confused. Hope I explained properly
Kelly