Trying to make a Macro work with BeforeSave Event...

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows
Hello guys,

How are you? I was hoping if some one could guide me with the following code extracted from


The code is altered to work automatically each time with Save or SaveAs button. However there are lot of hit and misses. There are times when save is prompted twice. or even when browsing for a location to save the cancel click msgbox shows up.

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim userResponce As Boolean

On Error Resume Next
 userResponce = Application.Dialogs(xlDialogSaveAs).Show("Test name", 52)
On Error GoTo 0
If userResponce = False Then
    MsgBox "Cancel clicked"
    Exit Sub
Else
    MsgBox "You saved file "
End If
End Sub

Could anyone please alter it in ways so it can work for intended purpose?

Thank you.
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,400
Without your code, if you select SaveAs, the user is prompted with the SaveAs dialog file name selector. Your code also calls the SaveAs selector. So the user is prompted twice.

The Cancel = True line cancels the first one and uses the one in your code.

Rich (BB code):
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    
    userResponce = Application.GetSaveAsFilename("Test name")
    
    If userResponce = "False" Then
        MsgBox "Cancel clicked"
        Exit Sub
    Else
        Application.EnableEvents = False
        ThisWorkbook.SaveAs userResponce
        Application.EnableEvents = True
        MsgBox "You saved file "
    End If
End Sub
 
Last edited:

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows
I tested your code and it worked fine but the execute specific filetype is missing which is 52 for a macro enabled workbook or 51 for plain excel workbook. at the moment there is none associated with "Test name".
further help will be appreciated.

Thanks.
 

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

It's a macro enabled workbook by default. I has code in it.

I actually needed the Excel workbook .xlsx file type extension. Did some research and the following script will do.

VBA Code:
    userResponce = Application.GetSaveAsFilename("Test name", "Excel Workbook(*.xlsx), *.xlsx")

Thanks again.
 

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows
It's a macro enabled workbook by default. I has code in it.

The file is going to be write protected and will only allow for SaveAs. Hence the original macro enabled workbook stays intact .
 

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows
Here is my final code which works now because I was getting file format errors..but now after including FileFormat:=xlOpenXMLWorkbook to this Workbook.SaveAs, it runs as desired. Two things are achieved with the code below.
1. the user has a predefined name and extension set whenever save button is clicked. and
2. the links will break when user saves the file and will not break if the user clicks on cancel.

Due to the fact that file extension cannot be set to .xlsm (macro-enabled workbook) in first part of the code, hence there will be no chance of overwriting it accidentally with the default macro enabled one.

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    Dim ExternalLinks As Variant
    Dim x As Long
    Dim wb As Workbook
    Set wb = ActiveWorkbook


    userResponce = Application.GetSaveAsFilename("Sales Report - Month Year", "Excel Workbook(*.xlsx), *.xlsx")

    If userResponce = "False" Then
        Exit Sub
    Else
    wb.Unprotect "1234"
    wb.ActiveSheet.Unprotect "1234"
    ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(ExternalLinks) Then
    For x = 1 To UBound(ExternalLinks)
    wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
    Next x
    End If

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs userResponce, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End If
End Sub

Thank you AlphaFrog for your valuable and much appreciated code. : )
 

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
2,012
Office Version
  1. 2019
Platform
  1. Windows
I have to keep press the shift key before opening a macro workbook, just in case I need to change something. doing the Shift (pressed down) til the file opens up will not run any macros for the current session.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,927
Messages
5,627,675
Members
416,264
Latest member
Dezmo

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
Top