Save a copy of the Excel file to another location every 15 seconds

[sofas]

Hello everyone, I have an excel file that consists of two sheets. I want the file to be automatically saved every 15 seconds and to save another copy of it in another place with the same name with the day and hour of saving. Thank you.

 

[Logit]

In a regular module :

Option Explicit


Sub shwMsg()
    
    Application.OnTime Now + TimeValue("00:00:15"), "sveMe"  '<---- change time delay here. Currently set to 5 minutes.
    
End Sub

Sub sveMe()

Application.DisplayAlerts = False
    ThisWorkbook.Save
    sveWrkBk
Application.DisplayAlerts = True
    shwMsg
    
End Sub

Sub stopMacros()
    Exit Sub
End Sub




'saves file every 15 secs
Sub sveWrkBk()
Dim FName           As String
Dim FPath           As String
Dim dt              As String
Dim wb              As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    wb = ActiveWorkbook.Name
    'ActiveWorkbook.SaveAs Filename:= _
    '    "F:\Documents and Settings\Tim\My Documents\" & wb & ".cen", FileFormat:=xlText, _
    '    CreateBackup:=False
    
    dt = Format(Now(), "mm-dd-yyyy hh mm")
    FPath = "C:\Users\jimga\Desktop\"       ''<--- Change SAVE DIRECTORY as required
    FName = wb & dt                         ''<--- Change name if required .. just this part / Auto Backup File - \
    ThisWorkbook.SaveCopyAs Filename:=FPath & FName & ".xlsm"
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

In the ThisWorkbook module :

Option Explicit

Private Sub Workbook_Open()
    shwMsg
End Sub

Download workbook : AutoSave w DateTime Name Every 15 secs.xlsm

 

[Logit]

This line : Application.OnTime Now + TimeValue("00:00:15"), "sveMe" '<---- change time delay here. Currently set to 5 minutes.

should say "Currently set to 15 seconds.