Results 1 to 9 of 9
  1. #1
    3 Star Lounger
    Join Date
    Apr 2007
    Location
    Lancashire, United Kingdom
    Posts
    233
    Thanks
    31
    Thanked 4 Times in 4 Posts

    Change the default behaviour of the "save" button?

    I have a spreasdsheet - when a user clicks on "Save" (or does it from the menu), I want my macro to be run instead (it will add the current date/time to the end of the filename to force a sort of versioning).

    How do I intercept the "Save" event?

    regards

    Alan

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,474
    Thanks
    211
    Thanked 848 Times in 780 Posts
    Alan,

    See this MS Article. Place the code in the workbook module. HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  3. #3
    3 Star Lounger
    Join Date
    Apr 2007
    Location
    Lancashire, United Kingdom
    Posts
    233
    Thanks
    31
    Thanked 4 Times in 4 Posts
    Thanks RG. I did find that article and applied it.

    My code looks like this, but for some reason, it posts the message box twice - no idea why though - any clues?:

    It also asks me if I want to save it when I exit (but I think I can fix that with a "saved = true" setting somewhere.

    Code:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
            Cancel As Boolean)
    
        
        myyear = Year(Now)
        mymon = Month(Now)
        myday = Day(Now)
        SaveAs Filename:="E:\Users\Alan\Documents\cubs\Backup of accounts\Master " & myyear & "-" & mymon & "-" & myday & ".xlsm"
        MsgBox ("File saved OK")
        Cancel = true
    End Sub

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,474
    Thanks
    211
    Thanked 848 Times in 780 Posts
    Alan,

    This should fix your problem.
    Code:
    Option Explicit
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
            Cancel As Boolean)
    
        Dim zMyYear  As String
        Dim zMyMon   As String
        Dim zMyDay   As String
        
        zMyYear = Year(Now)
        zMyMon = Month(Now)
        zMyDay = Day(Now)
        Application.EnableEvents = False   'Turn off Events so SaveAs doesn't recall the procedure!
        SaveAs Filename:="E:\Users\Alan\Documents\cubs\Backup of accounts\Master " & zMyYear & "-" & zMyMon & "-" & zMyDay & ".xlsm"
        Application.EnableEvents = True    'Turn Events back on
        MsgBox ("File saved OK")
        Cancel = True
        
    End Sub
    You can also add: Application.DisplayAlerts = False before the save command it you don't want it to warn you that the file already exists if you try to save it a second time on the same date!
    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  5. #5
    3 Star Lounger
    Join Date
    Apr 2007
    Location
    Lancashire, United Kingdom
    Posts
    233
    Thanks
    31
    Thanked 4 Times in 4 Posts
    Cheers RG - your code works fine.


    Alan
    Last edited by alan sh; 2014-07-04 at 14:34.

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,474
    Thanks
    211
    Thanked 848 Times in 780 Posts
    Alan,

    ActiveWorkbook.Name

    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  7. #7
    3 Star Lounger
    Join Date
    Apr 2007
    Location
    Lancashire, United Kingdom
    Posts
    233
    Thanks
    31
    Thanked 4 Times in 4 Posts

    And here is the final code

    Thanks to RG for his input. If anyone wants to use this, feel free. If you wish to modify it (maybe add hours, mins seconds etc) help yourself.

    The code will check if a directory called "backup" exists underneath the original folder. It stores a copy of the file in there with todays date before saving the original one in the orginal place. Note that I have got rid of the "Option Explicit" from RG's code as I am lazy

    Cheers

    Alan

    Code:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
            Cancel As Boolean)
    
        Dim zMyYear  As String
        Dim zMyMon   As String
        Dim zMyDay   As String
        Dim fs
        Set fs = CreateObject("Scripting.FileSystemObject") ' so we have access to the file system objects
        
        
        zMyYear = Year(Now)
        zMyMon = Format(Month(Now), "00")
        zMyDay = Format(Day(Now), "00")
        orig_Fname = ActiveWorkbook.FullName
        For i = 1 To Len(orig_Fname)
            If Mid(orig_Fname, i, 1) = "\" Then jpos = i
            If Mid(orig_Fname, i, 1) = "." Then jdot = i
        Next i
        fdir = Left(orig_Fname, jpos)
        orig_name = Mid(orig_Fname, jpos + 1, jdot - jpos - 1)
        Bdir = fdir & "backup"
        If Dir(Bdir, vbDirectory) = "" Then ' check that the backup directory exists
            'MsgBox ("No dir - " & Bdir)
            MkDir (Bdir)
        End If
        Application.EnableEvents = False   'Turn off Events so SaveAs doesn't recall the procedure!
        Application.DisplayAlerts = False
        SaveAs Filename:=Bdir & "\Backup of " & orig_name & " " & zMyYear & "-" & zMyMon & "-" & zMyDay & ".xlsm"
        Application.DisplayAlerts = False
        SaveAs Filename:=orig_Fname
        Application.EnableEvents = True    'Turn Events back on
        MsgBox ("Backup and original File saved OK")
        Cancel = True
        
    End Sub

  8. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,474
    Thanks
    211
    Thanked 848 Times in 780 Posts
    Alan,

    Might I suggest you move the second Application.DisplayAlerts down one line and change the False to True?

    You don't need to specify it more than once to keep it off and you'll want to turn it back on after you're done since you are not exiting Excel in your code.

    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  9. #9
    3 Star Lounger
    Join Date
    Apr 2007
    Location
    Lancashire, United Kingdom
    Posts
    233
    Thanks
    31
    Thanked 4 Times in 4 Posts
    Cheers - will do

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •