Force Save As a File Type

[archie00]

Hi.

I am trying to force the users of an excel file to Save it as a macro enabled workbook. I can do this fine. However, I still want the ability to be able to edit the template. So I need a way to either only allow me to save it as a template or simply to force users to save it as either a macro-enabled workbook OR a macro-enabled template.

This is the code I currently have (entered in the "ThisWorkbook" Section of the VBAProject):

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fName As String
 
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
MsgBox "You pressed cancel", vbOKOnly
Cancel = True
End If

Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.EnableEvents = True


End Sub

Any help would be much appreciated

 

[mvptomlinson]

Have you considered adding a few lines of code to add an InputBox prompt for a password when saving? If the password is typed incorrectly or the user cancels the inputbox then it goes to the "normal user" save-as xlsm. If the password is correct (only you would know it) then open the normal save-as UI.

You should password protect your vba project if you do that, too, so people can't read the code and see your save-as password.

 

[archie00]

Thanks for your quick reply. Nice idea...I haven't done that before (I'm a vba newbie) so I will give it a go. I'll report back how I go. Don't expect a quick reply as I'll be trying to work out how to do it.

 

[archie00]

OK...I give up in terms of the INput Box. If anyone can help with this, it would be much appreciated.

Basically, I want a macro that when you press save/save as, the following happens:
- If the file extension is .xltm, an InputBox opens requesting a password;
- If the password is correct it allows the user (generally just me) to save the file as any type of file;
- if the password is incorrect (or empty) it allows the user to save the file ONLY as an .xlsm file
- Else, if the file extension is anything other than .xltm (it'll generally only be a .xlsm file), the file is saved or saved as an .xlsm file

Does that make sense? Can anyone help?

Cheers

 

[mikerickson]

You could set it up so that entering a special file name sends you to the code for saving as something else.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fName As String
 
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
    MsgBox "You pressed cancel", vbOKOnly
    Cancel = True
End If
If fName Like "*AdministratorsSecretPassword*" Then
    Rem special code
    Application.EnableEvents = False
    Application.Dialogs(xlDialogSaveAs)
    Application.EnableEvents = True
Else
    Rem save as .xlsm
    Application.EnableEvents = False
    ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.EnableEvents = True
End If

End Sub

 

[archie00]

Thanks for your quick reply. I've put your code into the ThisWorkbook section of the VB editor...And changed the password to "bla" as a test. The macro doesn't seem to run when I press save or save as.

 

[archie00]

OK...this I've managed to create a macro that does the following:
- If the file type is xlsm, only allow the user to save as an xlsm
- If the file type is any other type (this will only be xltm), prompt for a password;
- If the password is correct, allow the user to save as any file type (I will be the only person who knows the password);
- If the password is incorrect, only allow the user to save as an xlsm

This basically means that if the user opens the template, they can only save as an xlsm, but if they've already saved it as an xlsm, no password input box pops up when they go to save it.

The code is as follows:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.Calculate
Dim fName As String

If Sheets("File Information").Range("A4").Value = "xlsm" Then
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
    MsgBox "You pressed cancel", vbOKOnly
    Cancel = True
Exit Sub
Else
Application.EnableEvents = False
    ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.EnableEvents = True
End If

Else
Dim MyPassword
MyPassword = InputBox("Please enter password", "Password Prompt", "********")

'hardcode password
If MyPassword = "bpscortum" Then
MsgBox "Access Granted", vbInformation, "Access"
'call macro
Application.Dialogs(xlDialogSaveAs).Show
GoTo Finish:
Else
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
    MsgBox "You pressed cancel", vbOKOnly
    Cancel = True
Exit Sub
Else
Application.EnableEvents = False
    ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.EnableEvents = True
    
End If
End If
End If
Finish:
Application.Calculate
End Sub

Where Range("A4") contains a formula that works out the file type (using cell function). So basically the whole macro works beautifully when it's not a Private Sub and doesn't have the (ByVal SaveAsUI As Boolean, Cancel As Boolean) bit at the end. So when I press play in the VBA editor it works smoothly and if I assigned it to a button in my spreadsheet it would work beautifully...but I want it to work automatically whenever anyone presses Save or SaveAs.

Any help?

 

[archie00]

Just as a note to the last post...it is working now, but when it works it causes Excel to stop responding. ANy advice