Changing the behavior of ctrl+save in Excel

[Pardeep Singh]

I am trying to write a vba code to mutate the behavior of excel when user presses ctrl+s. I am updating the workbook so that when a user presses the ctrl+s key combo, a vba code is triggered. This will save the file with new name (save as). But the condition is the current execution of code should be 2 hours after the previous execution else it should just normally save the workbook.

Wrote following code to achieve it, but cannot connect it to keyboard shortcut ctrl+s

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim NewFileName As String
    Dim LastExecTime As Date
    
    'Get the last execution time from a named range called "LastExecTime"
    On Error Resume Next
    LastExecTime = Range("LastExecTime").Value
    If Err.Number <> 0 Then LastExecTime = Now - TimeSerial(2, 0, 0) 'Use current time - 2 hours as default value
    On Error GoTo 0
    
    'Check if the time difference between the last execution and the current time is at least 2 hours
    If DateDiff("h", LastExecTime, Now) >= 2 Then
        NewFileName = "V1_" & ThisWorkbook.Name 'Create the new file name with "V1_" as prefix and the current workbook name
        
        Application.DisplayAlerts = False 'Disable alerts to prevent the "Save As" dialog box from appearing
        ThisWorkbook.SaveAs Filename:=NewFileName, FileFormat:=xlOpenXMLWorkbook 'Save the workbook with the new file name
        Application.DisplayAlerts = True 'Re-enable alerts
        
        Cancel = True 'Cancel the default save function
        
        'Update the last execution time in the named range "LastExecTime"
        On Error Resume Next
        Range("LastExecTime").Value = Now
        If Err.Number <> 0 Then
            With Worksheets.Add
                .Name = "Settings"
                .Range("A1").Value = "LastExecTime"
                .Range("B1").Value = Now
                .Range("A1:B1").Name = "LastExecTime"
                .Visible = xlVeryHidden
            End With
        End If
        On Error GoTo 0
    Else
        Cancel = False 'Allow the default save function to execute
    End If
End Sub

Can someone please help me out with what am I missing.

 

[sijpie]

It should simply work, regardless of how you are saving.

Just to make sure: This code you have is code in the 'ThisWorkbook' module. Not in a normal module.

Start the code with

Debug.Print "Saved"

and comment out the rest.
Then do a save with Ctrl-S
Go back to VBA and it should show 'Saved' in the immediate window (bottom left).

If that works, then I would suggest to step through the code (by pressing the F8 key repeatedly) to see why it is not behaving as you expect. See more on how to debug in the document link in my tagline below.