Password protection

[azizrasul]

I use the following function to create a password on a MS Access database. Also. given the password, the function also allows a password to be modified or if the MS Access database has to have it's password removed, to enter the password and hence for the MS Access database to be free of any password protection. I am seeking similar code that will do this for a MS Excel file.

PLEASE NOTE that I am not seeking code to remove a password from a password protected MS Excel file without first having knowledge of the password in the first place.

Public Function SetDatabasePassword(strDatabasePath As String, Optional pNewPassword As Variant, Optional pOldPassword As Variant) As String
'https://www.engram9.info/access-2007-vba/using-ado-to-set-the-database-password.html

'To CREATE a new password for a database that is not password protected, use this.
'str = SetDatabasePassword("C:\Users\Aziz\Desktop\MS Excel Files\Test.accdb", "NEWpassword", "")

'To REMOVE a password, use this.
'str = SetDatabasePassword("C:\Users\Aziz\Desktop\MS Excel Files\Test.accdb", "", "OLDpassword")

'To MODIFY an existing password to a different password, use this.
'str = SetDatabasePassword("C:\Users\Aziz\Desktop\MS Excel Files\Test.accdb", "NEWpassword", "OLDpassword")

'If SetDatabasePassword("C:\Users\Aziz\Desktop\MS Excel Files\Test.accdb", "", "N") = "Invalid password for database" Then
'    MsgBox "Invalid password for database"
'End If
   
    Dim cnn As ADODB.Connection
    Dim strNewPassword As String
    Dim strOldPassword As String
    Dim strCommand As String
    Dim strProvider As String
   
    On Error GoTo Report_Error
   
    strProvider = "Microsoft.ACE.OLEDB." & Application.Version

    'If a password is not specified (IsMissing), the string is "NULL" WITHOUT the brackets.
    If IsMissing(pNewPassword) Then
        strNewPassword = "NULL"
    Else
        strNewPassword = "[" & pNewPassword & "]"
    End If
   
    If IsMissing(pOldPassword) Then
        strOldPassword = "NULL"
    Else
        strOldPassword = "[" & pOldPassword & "]"
    End If

    'Define the string to change the password.
    strCommand = "ALTER DATABASE PASSWORD " & strNewPassword & " " & strOldPassword & ";"
   
    'Open a connection to the database.
    Set cnn = New ADODB.Connection

    With cnn
        .Mode = adModeShareExclusive
        .Provider = strProvider
        If Not IsMissing(pOldPassword) Then
            .Properties("Jet OLEDB:Database Password") = pOldPassword
        End If
        .Open "Data Source=" & strDatabasePath & ";"
        .Execute strCommand
    End With
   
    If Len(pNewPassword) > 0 And Len(pOldPassword) = 0 Then
        strResult = "Password Set"
    ElseIf Len(pNewPassword) > 0 And Len(pOldPassword) > 0 Then
        strResult = "Password Modified"
    ElseIf Len(pNewPassword) = 0 And Len(pOldPassword) > 0 Then
        strResult = "Password Removed"
    End If
   
Exit_SetDatabasePassword:
    On Error Resume Next
    cnn.Close
    Set cnn = Nothing
    SetDatabasePassword = strResult
    Exit Function

Report_Error:
    If Err.Number = -2147467259 Then
        strResult = "Error in modifying or removing password." & vbCrLf & vbCrLf & "Check that there is an existing password."
    ElseIf Err.Number = -2147217843 Then
        strResult = "Invalid password."
    Else
        strResult = Err.Number & " " & Err.Description
    End If

'Exit as an error has occured.
Resume Exit_SetDatabasePassword

End Function[\code]