Setting password problem

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,621
Office Version
  1. 2019
Platform
  1. Windows
Can somone please test this for me. It works fine on my PC but not on others.

In Sheet2, cells A1 and A2, put some text. Then run the ThisWorkbook code.

It seems to crash for my users when it tries to retrieve the password:

Code:
        .Unprotect Password:=MyPassword.Password

ThisWorkbook:

Code:
Option Explicit

    Dim PasswordArray() As Variant
    
Public Sub Workbook_Open()
    
    With Me
    
        Call .SetPassword
        
        Call .UsersList
        
    End With

    Set MyAuthorisedUser = New ClsVariables
    
    MyAuthorisedUser.AuthorisedUser = False
    
    Dim PasswordElementsCounter As Integer
    
    For PasswordElementsCounter = LBound(PasswordArray, 1) To UBound(PasswordArray, 1)
    
        If ModFunctions.GetUsername = PasswordArray(PasswordElementsCounter, 1) Then
        
            MyAuthorisedUser.AuthorisedUser = True
        
            Exit For
        
        End If
        
    Next PasswordElementsCounter
        
    With Sheet1
        
        .Unprotect Password:=MyPassword.Password
        
        
            
        .Protect Password:=MyPassword.Password
        
    End With
    
    Erase PasswordArray()
    
End Sub

Sub SetPassword()

    Set MyPassword = New ClsVariables
    
    MyPassword.Password = ModFunctions.GetUsername
    
End Sub

Sub UsersList()
    
    PasswordArray = Sheet2.Cells(1, 1).CurrentRegion.Value

End Sub

ModFunctions:

Code:
Option Explicit

    Global MyAuthorisedUser As ClsVariables
    
    Global MyPassword As ClsVariables

Function GetUsername() As String

    GetUsername = LCase(String:=Environ("UserName"))

End Function


ClsVariables:

Code:
Option Explicit
    
    Private pAuthorisedUser As Boolean
    Private pPassword As String
    
Public Property Get AuthorisedUser() As Boolean
   
 AuthorisedUser = pAuthorisedUser

End Property

Public Property Let AuthorisedUser(ByVal AUser As Boolean)

    pAuthorisedUser = AUser

End Property

Public Property Get Password() As String

    Password = pPassword

End Property

Public Property Let Password(ByVal PWord As String)

    pPassword = PWord

End Property
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
38,948
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Works fine for me. What do you mean by crash - crash Excel, error message, or something else?
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,621
Office Version
  1. 2019
Platform
  1. Windows
The concept is as follows:</SPAN>

Instead of hard-coding a password, the program identifies the username logged on and sets that to be the password.</SPAN>

A sheet, Sheet2, holds the list of authorised users, so if the username is listed here, the sheet is unlocked, otherwise it remains locked.

When my users use it, it crashes, citing the password is not correct but that's impossible because the password is the username!
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
38,948
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
But if you saved the workbook with the sheet protected, the password is your username, not theirs.
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,621
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thanks, I think that's the problem (though how comes it didn't crash when you tried it)?
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
38,948
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Because I wasn't using your workbook, so the sheets weren't protected with a different password to start with.
 

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,621
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Of course, thanks.

Can you suggest a workaround? I like my concept of not having to hard-code a password.
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
38,948
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Unless there is one workbook per user, this won't work. If there is, then you merely need to unprotect the sheets before you send the workbook out.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,653
Messages
5,854,963
Members
431,689
Latest member
jacker01

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top