Securely store password in a VBA project

Question

I built a file used by various people in one of my company service.

Each sheet is protected by a password and all users entries are handled with a VBA user form. All sheets are protected by the same password and my code protect/unprotect sheet when users modify data.

The problem is I'm storing the password in clear text in the VBA project so as to call the ActiveSheet.Protect password method. The VBA project is also protected by this password.

Is there a secure way to store that password in the VBA project ?

Anyone who knows how to search a bit would find a code to crack that VBA project password and be able to read it.

EDIT :

I have thought of computing a new password each time the file is open by adding some randomness in it. This way one could read the code without knowing the password. Adding a msgbox could reveal it but only until the file is reopenend. The problem is I cannot manually unprotect/protect sheet with that method as I won't be aware of the password.

Answer 1

Summarising the useful info from comments:

• if your code has access to the password (even directly or through obfuscation) anybody having access to the code have access to the password too
• password protection of Excel VBA is very weak, it's a trivial job to crack it

Conclusion : there is no way securely storing password in Excel VBA

Answer 2

This should do the trick. The password is smp2smp2, which you will get when running GetPassword, but that actual value is not stored in the project. It is stored using the code 30555112012321187051111661144119, which will be converted to the actual password (human readable) by using CreatePasswordFromCode. By the way, I have no idea how to easily get the code that belongs to a certain password. And in this way, it is always 8 characters long, no room for changes unless you adjust the code. I have found this somewhere in an old project of somebody else, no source mentioned unfortunately.

Option Explicit

Function GetPassword() As String

    'the password is stored as codes, so the real password is not stored in this project
    GetPassword = CreatePasswordFromCode("30555112012321187051111661144119")

End Function

Function CreatePasswordFromCode(ByVal pstrPasswordCode As String) As String
Dim intChar As Integer
Dim intCode As Integer
Dim arrintShifts(0 To 7) As Integer
Dim arrlngCharCode(0 To 7) As Long
Dim strMessage As String

    intChar = 0
    intCode = 0

    For intCode = 0 To 7
        'store -8 to -1 into 0-7
        arrintShifts(intCode) = intCode - 8
    Next intCode

    'the code is stored by using the number of the letter of the password in the 4th character.
    'the real code of the character is directly behind that.
    'so the code 30555112012321187051111661144119
    'has on position 3, 055, 5, 112, 0, 123, 2, 118, 7, 051, 1, 116, 6, 114 and 4, 119
    'so sorted this is 0, 123, 1, 116, 2, 118, 3, 055, 4, 119, 5, 112, 6, 114, 7, 051
    'then there is also the part where those charcode are shifted by adding -8 to -1 to them.
    'leading to the real charactercodes:
    '0, 123-8, 1, 116-7, 2, 118-6, 3, 055-5, 4, 119-4, 5, 112-3, 6, 114-2, 7, 051-1
    '0, 115, 1, 109, 2, 112, 3, 050, 4, 115, 5, 109, 6, 112, 7, 050
    For intChar = 0 To 7
        If Mid(pstrPasswordCode, 1, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 2, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 5, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 6, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 9, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 10, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 13, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 14, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 17, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 18, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 21, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 22, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 25, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 26, 3) + arrintShifts(intChar))
        ElseIf Mid(pstrPasswordCode, 29, 1) = intChar Then
            arrlngCharCode(intChar) = (Mid(pstrPasswordCode, 30, 3) + arrintShifts(intChar))
        End If
    Next intChar

    'by getting the charcodes of these values, you create the password
    CreatePasswordFromCode = Chr(arrlngCharCode(0)) & Chr(arrlngCharCode(1)) & Chr(arrlngCharCode(2)) & Chr(arrlngCharCode(3)) & Chr(arrlngCharCode(4)) & Chr(arrlngCharCode(5)) & Chr(arrlngCharCode(6)) & Chr(arrlngCharCode(7))

End Function