CODEWITHSUNDEEP
excelvba
Jesper Kindt Larsen
Jesper Kindt Larsen

Reputation: 107

Limit Excel file to save only as macro enabled (.xlsm or .xlmt) by using VBA

I am trying to use the code below to limit both save and save as to save file with macros. Code is placed in "ThisWorkbook".

My main goal is to create a template with macros for other to use, but when they open the template the often forget to save it with macros because the default setting is .xlsx format.

The excel template is placed in Sharepoint as read only for all. People when then save a copy in their own folder either on sharepoint or a server.

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

' Declare variables.
Dim FileName As String
Dim FileLocation As String

' Check if the Save As command is being used.
If SaveAsUI = True Then

    ' Create a FileDialog object.
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogSaveAs)

    ' Set the file filter.
    fd.FilterIndex = 2
    fd.Filters.Clear
    fd.Filters.Add "Excel Macro-Enabled Workbook", "*.xlsm"
    fd.Filters.Add "Excel Macro-Enabled Template", "*.xltm"

    ' Display the file dialog box.
    If fd.Show = -1 Then
        FileName = fd.SelectedItems(1)
    Else
        Cancel = True
        Exit Sub
    End If

    ' Save the workbook or template with macros.
    Application.DisplayAlerts = False

    If Right(FileName, 5) = ".xlsm" Then
        ActiveWorkbook.SaveAs Filename:=FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Else
        ActiveWorkbook.SaveAs Filename:=FileName, FileFormat:=xlOpenXMLTemplateMacroEnabled
    End If

    Application.DisplayAlerts = True

    Cancel = True

End If

End Sub

But I get this error when saving: enter image description here enter image description here

Screenshot for last comment: enter image description here

Upvotes: 0

Views: 336

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

As I wrote in my above comment, `FileDialog(msoFileDialogSaveAs)' does not accept filters. So, everything related to filters will raise errors. Please, use the next way, instead:

Sub testSaveAsFilename()
 Dim fileSaveName As String, fileName As String

 fileName = left(ThisWorkbook.name, InStrRev(ThisWorkbook.name, ".") - 1): Stop

 fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileName, _
                            FileFilter:="Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                            "Workbook (*.xlst), *xlst", Title:="Save AS  MACRO ENABLED:")
 Debug.Print fileSaveName
End Sub

I did not implement it in your code, but it should be something extremely simple, I think...

And I would also like to suggest to use only *.xlsm as filter. Do you want them keeping the template on their own computer? I think it may be a spring of problems... I mean, if you modify the template and they keep using the saved once. In order to make the code letting you save it as template you can add the second filter conditioned by your user name.

In fact, such a version will look as:

Sub testSaveAsFilenameOnlyXlsm()
 Dim fileSaveName As String, fileName As String, filt As String
 
 fileName = left(ThisWorkbook.name, InStrRev(ThisWorkbook.name, ".") - 1)
 If Application.userName = "your user name" Then
        filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                "Workbook (*.xlst), *xlst"
 Else
        filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm"
 End If
 
 fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileName, _
        FileFilter:=filt, Title:="Save AS  MACRO ENABLED:")
                                        
 Debug.Print fileSaveName
End Sub

You may encrypt your user name and place it in a variable, to not be so clear for all not skilled (in VBA) users...

Re Edited:

The above code implemented in your code event:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim fileSaveName As String, FileName As String, filt As String, posDot As Long
 Const yourUserName As String = "your real user name" 'addapt it, please
 
 ' Check if the Save As command is being used.
 If SaveAsUI = True Then
        posDot = InStrRev(ThisWorkbook.Name, ".") 'check if a dot exists in the name (to separate extension)
        If posDot > 0 Then
            FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
        Else
            FileName = ThisWorkbook.Name
        End If
        If Application.UserName = "Fane Branesti" Then 'for your user name to also allow xltm extension:
               filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm, Excel Macro-Enabled Template " & _
                       "Workbook (*.xltm), *xltm"
        Else
               filt = "Excel Macro-Enabled Workbook (*.xlsm)," & "*.xlsm"
        End If
        
        fileSaveName = Application.GetSaveAsFilename(InitialFileName:=FileName, _
        FileFilter:=filt, Title:="Save AS  MACRO ENABLED:")
        If fileSaveName = "False" Then Cancel = True: Exit Sub

        Application.EnableEvents = False 'disable events after SaveAs
            If Right(fileSaveName, 5) = ".xlsm" Then
                ActiveWorkbook.SaveAs FileName:=fileSaveName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Else
                ActiveWorkbook.SaveAs FileName:=fileSaveName, FileFormat:=xlOpenXMLTemplateMacroEnabled
            End If
        Application.EnableEvents = True 'reenable events
        
        Cancel = True 'stop saving in the standard way
 End If
End Sub

Upvotes: 1

Related Questions