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
306
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.
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

mehidy1437

Active Member
Joined
Nov 15, 2019
Messages
258
Office Version
  1. 2013
Platform
  1. Windows
  2. Mobile
  3. Web
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
 

mark692

Active Member
Joined
Feb 27, 2015
Messages
306
Office Version
  1. 2016
Platform
  1. Windows
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.
 

mark692

Active Member
Joined
Feb 27, 2015
Messages
306
Office Version
  1. 2016
Platform
  1. Windows
maybe i should use ActiveWorkbook.SaveCopyAs but i dont know how to add the date on the filename for the backup file
 

mehidy1437

Active Member
Joined
Nov 15, 2019
Messages
258
Office Version
  1. 2013
Platform
  1. Windows
  2. Mobile
  3. Web

ADVERTISEMENT

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
 

mark692

Active Member
Joined
Feb 27, 2015
Messages
306
Office Version
  1. 2016
Platform
  1. Windows
perfect! thank you so much sir!
 

Watch MrExcel Video

Forum statistics

Threads
1,119,097
Messages
5,576,108
Members
412,697
Latest member
ahem27
Top