save a copy of a file that im using on other folder without closing the original file

mark692

Active Member
Joined
Feb 27, 2015
Messages
321
Office Version
  1. 2016
Platform
  1. Windows
hi guys i want to make a back up of my workbook every time i click a button, is this possible on VBA? i want to make a button that will save the opened workbook to a backup folder without closing the workbook, but the name of the saved backup workbook is the date on when i back up it, and automatically overwrite if the date name of a workbook that is about to be saved is already exist.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Try this, it will save the file in a predefined folder with current date & time at the last part of your original file name.
Change the folder as you need.
You can add this at your customize ribbon & can use it for any file, which is open at your window.
Capture.JPG

VBA Code:
Option Explicit

Sub SaveFileToFixedPath()

    Dim dt As String, MyName As String, fullName As String, fullName2 As String
    Dim FileExtFind As String, FileNameFind As String, count As Integer
    
    dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
    Const csPath As String = "F:\EXCEL FILE\"
    
    'ExtFind = Split(Filename, ".")(UBound(Split(Filename, ".")))
    
    MyName = ActiveWorkbook.Name
    count = Len(MyName) - Len(Replace(MyName, ".", ""))
    FileExtFind = Split(MyName, ".")(UBound(Split(MyName, ".")))
    FileNameFind = Split(MyName, ".")(LBound(Split(MyName, ".")))
    
            'If MyName = "*.*" Then
            If count >= 1 Then
                    
                    fullName = FileNameFind & "_" & dt & "." & FileExtFind
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=csPath & fullName
                    Application.DisplayAlerts = True
                    
                    Else
                    
                    
                    'fullName = MyName & "_" & dt & ".xlsm"
                    'If FileExtFind = "" Then
                    fullName2 = FileNameFind & "_" & dt & "." & ".xlsx"
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=csPath & fullName2
                    Application.DisplayAlerts = True
                                
            End If

End Sub
 
Upvote 0
Try this, it will save the file in a predefined folder with current date & time at the last part of your original file name.
Change the folder as you need.
You can add this at your customize ribbon & can use it for any file, which is open at your window.
View attachment 21074
VBA Code:
Option Explicit

Sub SaveFileToFixedPath()

    Dim dt As String, MyName As String, fullName As String, fullName2 As String
    Dim FileExtFind As String, FileNameFind As String, count As Integer
   
    dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
    Const csPath As String = "F:\EXCEL FILE\"
   
    'ExtFind = Split(Filename, ".")(UBound(Split(Filename, ".")))
   
    MyName = ActiveWorkbook.Name
    count = Len(MyName) - Len(Replace(MyName, ".", ""))
    FileExtFind = Split(MyName, ".")(UBound(Split(MyName, ".")))
    FileNameFind = Split(MyName, ".")(LBound(Split(MyName, ".")))
   
            'If MyName = "*.*" Then
            If count >= 1 Then
                   
                    fullName = FileNameFind & "_" & dt & "." & FileExtFind
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=csPath & fullName
                    Application.DisplayAlerts = True
                   
                    Else
                   
                   
                    'fullName = MyName & "_" & dt & ".xlsm"
                    'If FileExtFind = "" Then
                    fullName2 = FileNameFind & "_" & dt & "." & ".xlsx"
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=csPath & fullName2
                    Application.DisplayAlerts = True
                               
            End If

End Sub
hi sir mehidy1437 ive been busy for the past few days sorry for the late response, i have tried your code today and it works but the problem is it closes the original file and make the new file open. I want the file to be back up without opening the new file and without closing the original file.
 
Upvote 0
maybe i should use ActiveWorkbook.SaveCopyAs but i dont know how to add the date on the filename for the backup file
 
Upvote 0
Try with this...
VBA Code:
Option Explicit

Sub SaveFileToFixedPath()

    Dim dt As String, MyName As String, fullName As String, fullName2 As String
    Dim FileExtFind As String, FileNameFind As String, count As Integer
    
    'dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
    dt = Format(CStr(Now), "yyyy_mm_dd")
    Const csPath As String = "F:\EXCEL FILE\"
    
    'ExtFind = Split(Filename, ".")(UBound(Split(Filename, ".")))
    
    MyName = ActiveWorkbook.Name
    count = Len(MyName) - Len(Replace(MyName, ".", ""))
    FileExtFind = Split(MyName, ".")(UBound(Split(MyName, ".")))
    FileNameFind = Split(MyName, ".")(LBound(Split(MyName, ".")))
    
            'If MyName = "*.*" Then
            If count >= 1 Then
                    
                    fullName = FileNameFind & "_" & dt & "." & FileExtFind
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveCopyAs fileName:=csPath & fullName
                    Application.DisplayAlerts = True
                    
                    Else
                    
                    
                    'fullName = MyName & "_" & dt & ".xlsm"
                    'If FileExtFind = "" Then
                    fullName2 = FileNameFind & "_" & dt & "." & ".xlsx"
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveCopyAs fileName:=csPath & fullName2
                    Application.DisplayAlerts = True
                                
            End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,543
Latest member
MartinLarkin

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