VBA – Secure an Excel Workbook

While trying to help someone out in a forum, I developed the following procedure that can be called to secure an Excel workbook with a password, which will be required by users when trying to open the file, and thought it might be of use to other.

'---------------------------------------------------------------------------------------
' Procedure : XLS_SecureWrkBk
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Secure an Excel Wordbook with a Password to open the file
'               Returns True is Successful
'               Returns False when the process was unsuccessful
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFilePath : Path to the Excel Workbook
' sFileName : File name of the Workbook without the extension
' sFileExt  : Extension of the Workbook file (typically xls or xlsx)
' sPwd      : Password to set
'
' Usage:
' ~~~~~~
' Call XLS_SecureWrkBk("C:\Temp\", "Test", "xls", "MyPassword")
' Call XLS_SecureWrkBk("C:\Temp", "Test", "xlsx", "MyPassword")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-01-14              Initial Release
'---------------------------------------------------------------------------------------
Public Function XLS_SecureWrkBk(ByVal sFilePath As String, ByVal sFileName As String, _
                                ByVal sFileExt As String, ByVal sPwd As String) As Boolean
    Dim oExcel                As Object
    Dim oExcelWrkBk           As Object

    On Error GoTo Error_Handler
    'Ensure properly formatted path was supplied, adjust as req'd
    If Right(sFilePath, 1) <> "\" Then sFilePath = sFilePath & "\"

    'Validate that the supplied file actually exists
    If Len(Dir(sFilePath & sFileName & "." & sFileExt)) = 0 Then
        MsgBox "The file '" & sFilePath & sFileName & "." & sFileExt & _
               "' cannot be located.", vbCritical Or vbOKOnly, _
               "Unable to Secure the Excel Workbook"
        GoTo Error_Handler_Exit
    End If

    'Rename the file, so we can save the secured version with the proper name
    Name sFilePath & sFileName & "." & sFileExt As sFilePath & "MyTmp" & "." & sFileExt

    Set oExcel = CreateObject("Excel.Application")    'Start Excel
    oExcel.Visible = False   'Keep Excel hidden
    oExcel.ScreenUpdating = False    'Don't update visuals during this process
    oExcel.DisplayAlerts = False    'Don't display any warning prompts
    'Load the unsecured Workbook
    Set oExcelWrkBk = oExcel.WorkBooks.Open(sFilePath & "MyTmp" & "." & sFileExt)    'Start a new workbook
    'Save a new Secured version with the proper name
    oExcelWrkBk.SaveAs sFilePath & sFileName & "." & sFileExt, , sPwd
    oExcelWrkBk.Close False    'Close the workbook
    oExcel.Quit     'Close Excel
    'Delete the renamed and unsecured workbook
    Kill sFilePath & "MyTmp" & "." & sFileExt

    XLS_SecureWrkBk = True

Error_Handler_Exit:
    On Error Resume Next
    Set oExcelWrkBk = Nothing
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: XLS_SecureWrkBk" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    oExcel.DisplayAlerts = True
    oExcel.ScreenUpdating = True
    oExcel.Visible = True   'Make excel visible to the user
    Resume Error_Handler_Exit
End Function