none
Ensure that Workbook gets saved as Macro Enabled in VBA RRS feed

  • Question

  • I have an Excel (2013) Macro Enabled Template.  I want to ensure that workbooks based on the template get saved as macro-enabled workbooks.  I tried this code and it saves the workbook without the correct extension or format (it saves as a file with no extension) Excel warns that the extension and format do not match.

    Sub SaveMeAsMacroEnabled()
         Do
             fName = Application.GetSaveAsFilename
         Loop Until fName <> False
    '
        ActiveWorkbook.SaveAs Filename:=fName _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End Sub

    I also tried this in the ThisWorkbook object with this code:

    'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    '        Do
    '            fName = Application.GetSaveAsFilename
    '        Loop Until fName <> False
    '
    '    ActiveWorkbook.SaveAs Filename:=fName _
    '        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    'End Sub

     This never saved the file at all, continued to ask for the Filename and crashed Excel.

    What am I doing wrong?

    Thank you

    Friday, March 24, 2017 5:38 PM

Answers

  • The code is really only getting the file name of the file you select in the dialog. If you select an xlsx file in the dialog then the code will use the .xlsx file name in the Save command and then because the code says as Macro Enabled, the file extension is invalid.

    To save as an xlsm file name try the following where the xlsx extension is replaced with .xlsm

    Sub SaveMeAsMacroEnabled()
        Dim fName
       
        Do
            fName = Application.GetSaveAsFilename
        Loop Until fName <> False
       
        fName = Replace(fName, "xlsx", "xlsm")
       
        ActiveWorkbook.SaveAs Filename:=fName, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
     End Sub


    The above will only work if you select either an xlsx or xlsm filename. If you select any other type of file then the extension will not be replaced and the code will still fail.

    The following code finds the dot in the file name (looking backwards from the end of the string) and then concatenates the part of the string up to the dot with xlsm to create the file name.

    Following code modified since initial posting to allow for the user typing a name in the field without including an extension.

    Sub SaveMeAsMacroEnabled_2()
        Dim fName
        Dim lngDot As Long
       
        Do
            fName = Application.GetSaveAsFilename
        Loop Until fName <> False
       
        lngDot = InStrRev(fName, ".")
       
        If lngDot = 0 Then      'If lngDot is zero then NO extension included with file name
            fName = fName & ".xlsm"     'Concatenate filename plus dot and extension.
        Else
            fName = Left(fName, lngDot) & "xlsm"    'Dot found so concatenate with extension only
        End If
       
        ActiveWorkbook.SaveAs Filename:=fName, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
     End Sub


    Regards, OssieMac



    • Edited by OssieMac Saturday, March 25, 2017 3:44 AM
    • Marked as answer by froggygremblin Monday, March 27, 2017 5:58 PM
    Saturday, March 25, 2017 3:31 AM
  • Are you attempting to save as several different file names by using the loop? If so, then the code example below. However, if you only want to save once to one file name then comment out the "Do" and "Loop" and it will just save once (unless the user Cancels).

    I suggest that you retain the code to ensure that it is an xlsm workbook that is saved.

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
       
        Application.EnableEvents = False    'Suppress recursive calls to this routine when the code below saves
       
        Cancel = True   'Cancel the original called Save and then Save with code below
       
        Dim fname
        Dim lngDot As Long
       
        Do          'Comment out for single save only
            fname = Application.GetSaveAsFilename
            If fname = False Then
                Cancel = True       'Cancel the save operation
                GoTo ReEnableEvents
            End If
           
            lngDot = InStrRev(fname, ".")
           
            If lngDot = 0 Then      'If lngDot is zero then NO extn included with file name
                fname = fname & ".xlsm"     'concatenate filename and dot plus extension.
            Else
                fname = Left(fname, lngDot) & "xlsm"    'Dot found so concatenate with ext only
            End If
           
            Application.DisplayAlerts = False   'Optional code to suppress message that file exists
           
            ActiveWorkbook.SaveAs Filename:=fname, _
                    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                   
            Application.DisplayAlerts = True   'Turn alerts on again
           
        Loop        'Comment out for single save only
       
    ReEnableEvents:
       
        Application.EnableEvents = True
    End Sub


    Regards, OssieMac

    Monday, March 27, 2017 11:30 PM
  • A little extra info.

    If at any time you perform edits on the main workbook and you want to be able to save it back to the same original file name then there are 2 methods of doing this.

    Method 1: First save it to a new file name and then close the workbook. Re-open the new file name and you can then save it back to the original file name.

    Method 2: In the VBA editor, Open the Immediate window with Ctrl and G.

    In the Immediate window type Application.EnableEvents = False   and press Enter  (This disables the event and the workbook can be saved normally without invoking the Before Save code)

    Re-Enable events by typing  Application.EnableEvents = True in the Immediate window and press Enter. (You can actually just go back to the previous command in the Immediate window and edit the False to True and press Enter and that works.)

    If you want to perform significant edits on the workbook and don't want the problem of the Before Save event you can simply disable the event completely by editing the sub name like the following example with a character or two appended to the Sub name like the following. (Changing the sub name disables it).

    Private Sub Workbook_BeforeSave_A(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Don't forget to remove the extra character/s before final save which might need to be done with Method 1 or 2 above.


    Regards, OssieMac

    • Marked as answer by froggygremblin Wednesday, March 29, 2017 6:59 PM
    Wednesday, March 29, 2017 6:18 AM

All replies

  • The code is really only getting the file name of the file you select in the dialog. If you select an xlsx file in the dialog then the code will use the .xlsx file name in the Save command and then because the code says as Macro Enabled, the file extension is invalid.

    To save as an xlsm file name try the following where the xlsx extension is replaced with .xlsm

    Sub SaveMeAsMacroEnabled()
        Dim fName
       
        Do
            fName = Application.GetSaveAsFilename
        Loop Until fName <> False
       
        fName = Replace(fName, "xlsx", "xlsm")
       
        ActiveWorkbook.SaveAs Filename:=fName, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
     End Sub


    The above will only work if you select either an xlsx or xlsm filename. If you select any other type of file then the extension will not be replaced and the code will still fail.

    The following code finds the dot in the file name (looking backwards from the end of the string) and then concatenates the part of the string up to the dot with xlsm to create the file name.

    Following code modified since initial posting to allow for the user typing a name in the field without including an extension.

    Sub SaveMeAsMacroEnabled_2()
        Dim fName
        Dim lngDot As Long
       
        Do
            fName = Application.GetSaveAsFilename
        Loop Until fName <> False
       
        lngDot = InStrRev(fName, ".")
       
        If lngDot = 0 Then      'If lngDot is zero then NO extension included with file name
            fName = fName & ".xlsm"     'Concatenate filename plus dot and extension.
        Else
            fName = Left(fName, lngDot) & "xlsm"    'Dot found so concatenate with extension only
        End If
       
        ActiveWorkbook.SaveAs Filename:=fName, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
     End Sub


    Regards, OssieMac



    • Edited by OssieMac Saturday, March 25, 2017 3:44 AM
    • Marked as answer by froggygremblin Monday, March 27, 2017 5:58 PM
    Saturday, March 25, 2017 3:31 AM
  • Thanks OssieMac.  Your solution does work.  My original code saved the file with no "." or extension.  so now this code works

    Sub SaveMeAsMacroEnabled()
         Do
             fName = Application.GetSaveAsFilename
         Loop Until fName <> False

    '
         ActiveWorkbook.SaveAs Filename:=fName & ".xlsm" _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End Sub

    But this requires me to run the macro from a button.  I'd prefer it run automatically when the spreadsheet gets saved.  So I tried the same code in the "ThisWorkbook" object

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
           

    Do
             fName = Application.GetSaveAsFilename
         Loop Until fName <> False

    '
         ActiveWorkbook.SaveAs Filename:=fName & ".xlsm" _
            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End Sub

    and this does not work properly.  After I enter the fName The Do Loop repeats. if I try to cancel the GetSaveAsFilename dialog It keeps prompting for a new fName If I enter a second name Excel hangs.  When I kill Excel I see that it has saved the 1st fname I entered.  Having to kill Excel seems kinda crude.  Is there a way to do this that works?

           

    Monday, March 27, 2017 6:18 PM
  • Are you attempting to save as several different file names by using the loop? If so, then the code example below. However, if you only want to save once to one file name then comment out the "Do" and "Loop" and it will just save once (unless the user Cancels).

    I suggest that you retain the code to ensure that it is an xlsm workbook that is saved.

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
       
        Application.EnableEvents = False    'Suppress recursive calls to this routine when the code below saves
       
        Cancel = True   'Cancel the original called Save and then Save with code below
       
        Dim fname
        Dim lngDot As Long
       
        Do          'Comment out for single save only
            fname = Application.GetSaveAsFilename
            If fname = False Then
                Cancel = True       'Cancel the save operation
                GoTo ReEnableEvents
            End If
           
            lngDot = InStrRev(fname, ".")
           
            If lngDot = 0 Then      'If lngDot is zero then NO extn included with file name
                fname = fname & ".xlsm"     'concatenate filename and dot plus extension.
            Else
                fname = Left(fname, lngDot) & "xlsm"    'Dot found so concatenate with ext only
            End If
           
            Application.DisplayAlerts = False   'Optional code to suppress message that file exists
           
            ActiveWorkbook.SaveAs Filename:=fname, _
                    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                   
            Application.DisplayAlerts = True   'Turn alerts on again
           
        Loop        'Comment out for single save only
       
    ReEnableEvents:
       
        Application.EnableEvents = True
    End Sub


    Regards, OssieMac

    Monday, March 27, 2017 11:30 PM
  • The Do Loop was there only to ensure that some fName was entered.  It worked as a regular macro assigned to a button but failed in Private Sub Workbook_BeforeSave macro.  Removing the Do Loop in the BeforeSave routine fixed it and your code works great.  I still have one problem.  Once the xlsm workbook has been saved once if it is subsequently edited the BeforeSave macro fires again and asks for a new fName.  How can I test to see if it's already been saved and skip the BeforeSave macro in that case?

    I really do appreciate your helping out a complete novice

    Tuesday, March 28, 2017 4:09 PM
  • Originally I thought that because of the Do Loop that you were wanting to Save the workbook under several different names.

    Your last post has suggested to me that you just want to force the user to SaveAs under a new filename and not overwrite the file that the User opened. Is this assumption correct?

    If my assumption is correct then the code needed some tweaking so that the user could not save over top of the original file and the User must create a new filename. This is commonly done when the User opens a workbook that is being used as a template and you don't want the original template altered or if the User opens a previous version of the workbook (say last weeks update) and you want a new file name so that last weeks file is not over written.

    The following code will achieve what I am assuming is what you want but if I am wrong then please get back to me.

    At the top of a STANDARD module (ie. From within the VBA editor you select Menu item "Insert" -> "Module") insert the following Public variable before any subs in the STANDARD module.

    Public bolPrevSavedAs As Boolean    'Must be at top of STANDARD module before any Subs.

    Now the following code goes in ThisWorkbook module.

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
       
        On Error GoTo ReEnableEvents        'Required to ReEnable Events if error occurs
        Application.EnableEvents = False    'Suppress recursive calls to this routine
       
        If SaveAsUI = True Then Cancel = True       'Blocks use of "SaveAs" from Interactive mode.
       
        If bolPrevSavedAs = True Then GoTo ReEnableEvents      'This sub previously run so just allow normal save to run
       
        Cancel = True   'Cancel the original called Save and then Save with code below
       
        Dim fName As Variant    'Must be Variant so it can accept either String for FileName or False if Cancelled
        Dim lngDot As Long
       
        Do
       
            fName = Application.GetSaveAsFilename
            If fName = False Then
                Cancel = True       'Cancel the save operation
                GoTo ReEnableEvents
            End If
           
            lngDot = InStrRev(fName, ".")
           
            If lngDot = 0 Then      'If lngDot is zero then NO extn included with file name
                fName = fName & ".xlsm"     'Concatenate Dot and Filename Extension.
            Else
                fName = Left(fName, lngDot) & "xlsm"    'Dot found so concatenate with extension only
            End If
           
            If fName <> ThisWorkbook.FullName Then      'FullName includes the path
                Exit Do     'Will Exit the Do Loop and go to the SaveAs code
            Else
                MsgBox "SaveAs file name cannot be same as existing workbook name." & vbCrLf _
                        & "Enter a new name for workbook or Cancel to exit without saving."
                'Will loop back to Do line
            End If
        Loop
       
        Application.DisplayAlerts = False   'Optional code to suppress message that file exists
       
        ActiveWorkbook.SaveAs Filename:=fName, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
               
        bolPrevSavedAs = True
               
        Application.DisplayAlerts = True   'Turn alerts on again
           
       
    ReEnableEvents:
       
        If Err.Number <> 0 Then
            'If this MsgBox gets displayed to User then comment out the
            'first line of this code (ie.On Error GoTo ReEnableEvents) while debugging
            MsgBox "An error occurred in Private Sub Workbook_BeforeSave"
        End If
       
        Application.EnableEvents = True
     End Sub

    Additional information: On the first save then User can select Save or SaveAS. The code will run and the User is required to enter a new file name. Subsequent saves will save as normal to the new filename created without running the code. The user should be advised that after the first save to a new filename that the SaveAs is virtually disabled; it does nothing because it gets cancelled in the code.


    Regards, OssieMac

    Wednesday, March 29, 2017 3:28 AM
  • A little extra info.

    If at any time you perform edits on the main workbook and you want to be able to save it back to the same original file name then there are 2 methods of doing this.

    Method 1: First save it to a new file name and then close the workbook. Re-open the new file name and you can then save it back to the original file name.

    Method 2: In the VBA editor, Open the Immediate window with Ctrl and G.

    In the Immediate window type Application.EnableEvents = False   and press Enter  (This disables the event and the workbook can be saved normally without invoking the Before Save code)

    Re-Enable events by typing  Application.EnableEvents = True in the Immediate window and press Enter. (You can actually just go back to the previous command in the Immediate window and edit the False to True and press Enter and that works.)

    If you want to perform significant edits on the workbook and don't want the problem of the Before Save event you can simply disable the event completely by editing the sub name like the following example with a character or two appended to the Sub name like the following. (Changing the sub name disables it).

    Private Sub Workbook_BeforeSave_A(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Don't forget to remove the extra character/s before final save which might need to be done with Method 1 or 2 above.


    Regards, OssieMac

    • Marked as answer by froggygremblin Wednesday, March 29, 2017 6:59 PM
    Wednesday, March 29, 2017 6:18 AM
  • I should have been more clear about what I was trying to do.  Since my "main" workbook is a macro enabled template. Whenever it's launched it automatically creates a new unsaved macro enable workbook with the name "templatename1".  This as an unsaved workbook so the user is always prompted to SaveAs if they try to Close, Save, or SaveAs.  The problem I am having is sometimes they SaveAs an xlsx (macro free workbook), and of course it needs a bunch of formatting macros so that it prints out a pretty document. (This is a Landscape Project Bidding Template and if the Project is won I print out the documents to record, Project Scope, Time and Materials used.) So I want to enforce the file type they save as is an xlsm.  I only need to do this the first time they save the workbook.  After that they can (and do) make changes to the saved file as negotiations with the customer move on.  So a simple save will do the trick at that point. I don't need to protect the name of my template since they never open it directly.   So no DO LOOP required. 

    So what I did was use this

    theName = ActiveWorkbook.NamelngDot = InStrRev(theName, ".")
    If lngDot <> 0 Then      ' ".xlsm" was found & this workbook is already saved as a macro enabled 

    GoTo ReEnableEvents
    End If

    to also test if the ActiveWorkbook had "xlsm" in the file name and if so that means it's already been saved.  My completed code is below. It's working

    I am curious about  "Public bolPrevSavedAs As Boolean"  what does that do? 

    Wednesday, March 29, 2017 10:30 PM
  • Sorry the completed code

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        Dim fName
        Dim theName As String
        Dim IngDot As Long
           
        
           
            Application.EnableEvents = False 'Suppress recursive calls to this routine when the code below saves
            Cancel = True 'Cancel the original called Save and then Save with code below
           
            theName = ActiveWorkbook.Name
            IngDot = InStrRev(theName, ".xlsm")
            If IngDot <> 0 Then ' ".xlsm" was found & this workbook is already saved as a macro enabled workbook
                GoTo ReEnableEvents
            End If
            fName = Application.GetSaveAsFilename
                If fName = False Then
                    Cancel = True 'Cancel the Save operation
                    GoTo ReEnableEvents
                End If
               
                IngDot = InStrRev(fName, ".")
                If IngDot = 0 Then  'If lngDot is zero then NO extn included with file name
                    fName = fName & ".xlsm" 'concatenate filename and dot plus extension
                Else
                    fName = Left(fName, IngDot) & "xlsm" 'Dot found so concatenate with ext only
                End If
               
     '       Loop Until fName <> False

                ActiveWorkbook.SaveAs Filename:=fName _
                    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                   
    ReEnableEvents:
                Application.EnableEvents = True
    End Sub

    Wednesday, March 29, 2017 10:31 PM
  • Spoke to soon, had to add

    ReEnableEvents:
                Cancel = False 'without this I can't save later changes, it makes me save the template created worksheet twice the first time but its OK after that
                
                Application.EnableEvents = True
    End Sub

    Wednesday, March 29, 2017 10:49 PM