Question

我有一个处理一系列输入工作簿的工作簿，其中一些工具簿设置了VBA密码，但未锁定查看 - 即导航vb代码不需要密码，但查看项目属性需要密码（例如工具/参考资料）。在这种情况下，即使设置了密码，VBProject.Protection也会设置为vbext_pp_none。我可以检查什么来检测“查看项目属性的密码”？

Answer 1

当您保护项目时，您必须勾选方框并提供密码。

如果您提供的密码没有勾选方框，则不会应用保护
如果您在提供密码的方框中打勾，系统会提示您添加密码以继续

换句话说，你的一个但另一个的逻辑是有道理但不会发生（我知道（我在Excel 2010上测试过）），它是vbext_pp_none（0）或{ {1}} ...（1）。

编辑/补充： -

在阅读你的评论后，我无法重现这种情况，但在所有版本/平台中，我无法想象它是不可能的。下面是一个示例，在错误捕获过程中尝试更改属性，如果成功，则它根本不被锁定。

vbext_pp_locked

Answer 2

以下代码依赖于问题中不存在的信息，但如果使用Excel 2010（已测试）或2007（未经测试）专门在PC上工作，则应检测是否存在密码以及您已有的代码和在上一个答案的代码中，它应该回答检测密码存在的方法的问题。

最新的办公文件格式是一个zip包，为此您可以将其从.xlsm重命名为.zip并查看其内容。在zip包中，bin文件夹中可能存在xl文件（如果文件中没有VBA，则不存在）。在bin文件中有一个名为'DPB'的字符串值，该值已加密，但如果有密码，则值为long，因此可以通过'DPB'的长度检测到密码的存在值。

以下代码将受益于重要的错误处理，因为发生了大量文件操作，并且如上所述，这与前一个答案中的代码的更改版本一起使用，应该提供问题的答案

下面的代码需要添加“Windows Scripting Runtime”参考（工具＆gt;参考＆gt;勾选'Windows Scripting Runtime'），我没有后期绑定，以便更快地编写它并且可能更清晰。我还在整个代码中评论了描述正在发生的事情

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

vba项目属性密码

2 个答案: