vba project properties password

Question

I have a workbook which processes a series of input workbooks, some of which have VBA password set but are not locked for viewing – i.e. no password is required to navigate the vb code but a password is required to view project properties (e.g. Tools/References). In this situation VBProject.Protection is set to vbext_pp_none even though a password is set. What can I check to detect that ‘Password to view project properties’ is present?

Answer 1

When you protect the project you must both tick the box and supply a password.

• If you supply a password without ticking the box the protection is not applied
• If you tick the box with supplying a password your are prompted to add a password to continue

In other words, your logic of one but the other makes sense but doesn't happen (that I'm aware of (I tested on Excel 2010)), it is either vbext_pp_none(0) or vbext_pp_locked(1).

EDIT/ADDITIONAL: -

After reading your comments, I could not reproduce the situation but amongst all the versions/platforms I can't imagine it's not possible. Below is a example whereby a property is attempted to be changed while in an error trapping procedure, if its successful then it wasn't locked at all.

Public Sub Sample()
Dim WkBk As Workbook

Set WkBk = Application.Workbooks.Open(Environ("UserProfile") & "\Desktop\Book1.xlsm")
    If WkBk.VBProject.Protection = 1 Then 'vbext_pp_locked then
        MsgBox "It is locked"
    Else
        If LockedForEdits(WkBk) Then
            MsgBox "It is locked for edits"
        Else
            MsgBox "It is not locked"
        End If
    End If
    WkBk.Close 0
Set WkBk = Nothing
End Sub

Private Function LockedForEdits(ByRef WkBk As Workbook) As Boolean
Dim StrDescription As String

On Error GoTo ErrorHandle

StrDescription= WkBk.VBProject.Description
WkBk.VBProject.Description = WkBk.VBProject.Description & "TEST"
WkBk.VBProject.Description = StrDescription

Exit Function
ErrorHandle:
Err.Clear
LockedForEdits = True
End Function

Answer 2

The below code relies on information not present in the question but, if working exclusively on a PC using Excel 2010 (tested) or 2007 (not tested) it should detect the presence of a password and along with code you already have and code in the previous answer, it should answer the question of a way of detecting the presence of a password.

The latest office file format is a zip package, to that end you can rename it from .xlsm to .zip and view its content. Within the zip package there may be a bin file (not present if there is no VBA in the file) in the xl folder. In the bin file there is a string value called 'DPB' the value is encrypted but if there is a password, the value is long, thus the presence of a password can be detected by the length of the 'DPB' value.

The below code will benefit from significant error handling as there is a lot of file manipulation happening, and as mentioned, this used in conjunction with an altered version of the code in the previous answer, should provide with the answer to the question.

The code below will need the 'Windows Scripting Runtime' reference added (Tools > References > tick 'Windows Scripting Runtime'), I didn't late-bind to make writing it quicker and potentially clearer. I've also commented throughout the code to describe what is happening

Public Sub Sample()
Dim FSO             As New FileSystemObject
Dim Shl             As Object
Dim Fl              As Scripting.File
Dim Fldr            As Scripting.Folder
Dim LngCounter      As Long
Dim Ts              As Scripting.TextStream
Dim StrTmpFldr      As String
Dim StrWkBk         As String
Dim StrWkBkName     As String
Dim StrContainer    As String
Dim WkBk            As Excel.Workbook

'A place to work with temp files, for my own ease I done it on the desktop
'but this is not good practice
StrTmpFldr = Environ("UserProfile") & "\Desktop\"

'A path to a workbook (may be passed in)
StrWkBk = Environ("UserProfile") & "\Desktop\Book4.xlsm"

'We need the file name seperate from the path
StrWkBkName = Right(StrWkBk, Len(StrWkBk) - InStrRev(StrWkBk, "\"))

'Copy the workbook and change it to a .zip (xlsx, and other new forms are zip packages)
FSO.CopyFile StrWkBk, StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".")) & "zip", True

'Create a folder to extract the zip to
FSO.CreateFolder StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".") - 1)

'Unzip it into the folder we created
Set Shl = CreateObject("Shell.Application")
    Shl.Namespace(StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".") - 1) & "\").CopyHere Shl.Namespace(StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".")) & "zip").Items
Set Shl = Nothing

'Delete the zip
FSO.DeleteFile StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".")) & "zip", True

Set Fldr = FSO.GetFolder(StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".") - 1) & "\xl\")

    'Is there a project file? (there won't be if there is no code in it)
    For Each Fl In Fldr.Files
        If Right(Fl.Name, 4) = ".bin" Then Exit For
    Next

    If Fl Is Nothing Then
        MsgBox "It is not protected"
    Else
        'Parse the file looking for the line starting "DPB="" if the value in here is over 25 long,
        'then it is storing a password
        Set Ts = Fl.OpenAsTextStream(ForReading)
            Do Until Ts.AtEndOfStream
                StrContainer = Ts.ReadLine
                If Left(StrContainer, 5) = "DPB=" & """" Then
                    StrContainer = Replace(Replace(StrContainer, "DPB=", ""), """", "")
                    If Len(StrContainer) > 25 Then
                        MsgBox "It is protected"
                    Else
                        MsgBox "It is not protected"
                    End If
                    Exit Do
                End If
            Loop
            Ts.Close
        Set Ts = Nothing
        Set Fl = Nothing
    End If

Set Fldr = Nothing

'Delete the folder
FSO.DeleteFolder StrTmpFldr & Left(StrWkBkName, InStrRev(StrWkBkName, ".") - 1), True

End Sub