VBA：如何使用代码对模块进行密码保护？

Question

我有一个文件，它保存了自己的副本以便发送给特定的收件人，因此你最终会得到许多只包含特定收件人信息和包含所有信息的原始主文件的文件。当制作特定收件人的文件时，我有代码删除除与该收件人相关的信息之外的所有内容，并使用下面的函数随机生成密码锁定工作簿和工作表：

Function Pwd(iLength As Integer) As String
Dim i As Integer, iTemp As Integer, bOK As Boolean, strTemp As String
'48-57 = 0 To 9, 65-90 = A To Z, 97-122 = a To z
'amend For other characters If required
For i = 1 To iLength
    Do
        iTemp = Int((122 - 48 + 1) * Rnd + 48)
        Select Case iTemp
        Case 48 To 57, 65 To 90, 97 To 122: bOK = True
        Case Else: bOK = False
        End Select
    Loop Until bOK = True
    bOK = False
    strTemp = strTemp & Chr(iTemp)
Next i
Pwd = strTemp
End Function

是否可能锁定模块，使其无法被编辑？我想要的是与Excel提供的Visual Basic相同的功能，方法是转到工具 -> VBAProject - 项目属性 -> 保护，但通过代码来实现，以便可以将其应用于每个接收者特定的文件。

我可以使用以下代码对工作表应用保护：

Sheets(1).Protect Password, True, True

并且对于带有类似以下代码的工作簿：

ActiveWorkbook.Protect Password, True, False

但是有什么工具可以用来锁定模块吗？

- Ben Smith

---

唯一操纵VBA密码的方法是欺骗并使用SendKeys。Excel（或任何其他Office应用程序）没有公开其API。请参见：https://dev59.com/gWQo5IYBdhLWcg3wSNtw - Carl Colijn

@BenSmith 我不明白。您基本上正在创建具有相关可编辑数据的新文件，其中已删除了其他所有内容，因此您将不得不以某种方式将接收者发送回来的数据合并到主文件中。在这种情况下，是什么阻止您仅使用主文件生成不带任何给定接收者的所有相关选项卡的新代码免费文件，并发送该文件，而不是带有您不想显示的vba代码的编辑副本的主文件？ - InBetween

@BenSmith 更好的方法。我仍然不明白为什么你需要发送一个修剪过的主文件？难道你不能有一个空白模板 .xls 文件，其中包含所有必要的结构（工作表、图表等）和严格要求的代码，以便于查看时方便地受到保护吗？每当你需要向收件人发送数据时，只需复制模板，将相关数据复制到其中并发送该文件即可。 - InBetween

@BenSmith 显然，您需要在主文件中编写必要的代码以自动创建新文件。我想，基本上是复制、粘贴和另存为操作，编写这样的代码不会太难，而且我非常怀疑这种方法会比为每个收件人修剪主文件慢得多。是的，我知道您正在询问其他事情，但是您所要求的并不容易实现，我甚至不确定是否可能在没有一些极端黑客攻击的情况下完成，因此寻找解决方法总是明智的选择。 - InBetween

代码实际上必须在您分发的文件中吗？为什么不让您正在定制的主文件没有代码？将代码存储在不同的工作簿中，作为加载项加载，并在主文件上运行它... - Cindy Meister

Answer 1

尽管已经提供了关于Excel密码/保护安全性的良好建议，以及由Carl Colijn提供的全面（非SendKeys）解决方案，但我自己使用了肮脏的SendKeys方法，并取得了一些成功 - 请参见下面的示例，此处获取有关SendKeys的更多详细信息。 YMMV等。

请注意，您将需要在Excel信任中心>宏设置中找到“信任访问VBA项目对象模型”选项，或者根据您的Excel版本找到相应的选项。

Sub UnprotectVBProj(ByRef WB As Workbook, ByVal Pwd As String)

    Dim vbProj As Object

    Set vbProj = WB.VBProject

    If vbProj.Protection <> 1 Then Exit Sub ' already unprotected

    Set Application.VBE.ActiveVBProject = vbProj

    SendKeys "%TE" & Pwd & "~~"

End Sub

Sub ProtectVBProj(ByRef WB As Workbook, ByVal Pwd As String)

    Dim vbProj As Object

    Set vbProj = WB.VBProject

    If vbProj.Protection = 1 Then Exit Sub ' already protected

    Set Application.VBE.ActiveVBProject = vbProj

    SendKeys "%TE+{TAB}{RIGHT}%V%P" & Pwd & "%C" & Pwd & "{TAB}{ENTER}"

End Sub

- Andy Bethell