CODEWITHSUNDEEP
excelvba
YasserKhalil
YasserKhalil

Reputation: 9538

Set password for open by VBA instead of built-in feature

I have a previous topic about setting password for another workbook. The other workbook is named "Sample.xlsm" Protect closed workbook with password

Now I need to make the user input the password from the Sample.xlsm itself and at the same time to prevent the user from changing the password

I used this

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.DisplayAlerts = False
        If SaveAsUI Then MsgBox "SaveAs Feature Disabled", vbExclamation: Cancel = True
    Application.DisplayAlerts = True
End Sub

But this seems not enough from preventing the user to save the workbook with another name.

Upvotes: 0

Views: 66

Answers (1)

SeanC
SeanC

Reputation: 15923

To force only saving to a specific location:

This is the code that should stop most attempts at saving:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = False
    Cancel = True
    Call MySaveCode
BackToExcelSave:
    Application.EnableEvents = True
End Sub

Then you have to add code for your save, and avoid triggering excels' default save routine:

Sub MySaveCode()

    On Error GoTo ReEnable ' Use On Error in case they cannot save to specified location/filename
    Application.EnableEvents = False ' turn off excel default action (Workbook_BeforeSave)
    Dim Path As String
    Dim FileName As String

    Path = "C:\Users\SeanC\Documents\Excel\"

    FileName = "MyFixedFilename.xlsm"

    Application.DisplayAlerts = False    'Optional. Suppresses default excel messages

    ThisWorkbook.SaveAs Filename:= _
            Path & FileName, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
            CreateBackup:=False, _
            Password:="P@$$w0rd"

    MsgBox "Saved as: " & ThisWorkbook.FullName 'Also Optional

ReEnable:
     Application.DisplayAlerts = True    'Optional
     Application.EnableEvents = True
End Sub

Upvotes: 2

Related Questions