从Excel文档中删除密码

我正在提供内部支持，我们的一位用户设法将密码意外地输入到excel文件中，我已经进行了适当的检查，以确保用户应有权访问文档，并且现在想知道从Excel文档中删除密码的建议。

出于其价值，密码将在Excel打开后显示，但您无法在excel中看到任何数据之前显示。

Elcomsoft制作了一个非常有用的程序，称为Advanced Office Password Recovery，它可以比我用过的其他工具做得更好。

在尝试进行此操作之前，可能值得在要恢复的数据上加上一个值，有时让用户从头开始重新创建文档（并教给他们一个宝贵的教训;-)），这样的开销会更便宜。AOPR不是免费的，有时只能通过蛮力（尝试所有可能的字母组合）来算出密码，这可能需要很长时间。

是这样的东西，Excel Password Remover XLA加载项，您需要做什么？

编辑：考虑一下，也许不是-这用于从受保护的工作表/工作簿中删除密码。

如果您知道密码是什么，请继续并打开Excel文档。然后单击文件>另存为。在“保存”按钮的左侧是一个下拉菜单，标有“工具”。单击该，然后单击常规选项。删除那里的密码条目，然后单击“确定”。保存文档。

如果您不知道密码是什么，则可以使用VBA进行查找。如果我不得不猜测，您的用户可能未使用超强密码，因此我们可以使用蛮力类型方法来找到它。下面的代码很粗糙，但是它帮助我在一些用户文档中找到了一个微弱的丢失密码。它检查ASCII字符从1到z的任何长度的密码。您可以从立即窗口中调用它，然后等待几分钟，如下所示：

? GetPassword("D:\mywkbk.xlsx")

--

Public Function GetPassword(ByRef sFileName As String) As String
On Error Resume Next
    Dim pw As String
    pw = ""
    Do
        VBA.Err.Clear
        pw = GenerateNextPassword(pw)            
        Application.Workbooks.Open sFileName, False, True, , pw, pw
        VBA.DoEvents
    Loop While VBA.Err.Number = 5408
    GetPassword = pw
End Function

Public Function GenerateNextPassword(ByRef sCurrentPassword As String) As String
    Const MAX_CHAR = 122
    Const MIN_CHAR = 49

    Dim sCurrentPasswordMax As String
    Dim sNewPassword As String
    Dim i As Long

    sCurrentPasswordMax = String(Len(sCurrentPassword), Chr(MAX_CHAR))
    If sCurrentPassword = sCurrentPasswordMax Then
        'do an increment that changes the length
        sNewPassword = String(Len(sCurrentPassword) + 1, Chr(MIN_CHAR))
        Debug.Print Now(); ": "; sNewPassword
    ElseIf Asc(Right(sCurrentPassword, 1)) = MAX_CHAR Then
        'do an increment that changes multiple characters
        sNewPassword = Left(sCurrentPassword, Len(sCurrentPassword) - 1) & Chr(MIN_CHAR)
        For i = Len(sCurrentPassword) - 1 To 1 Step -1
            sNewPassword = Left(sNewPassword, i - 1) & Chr(Asc(Mid(sNewPassword, i, 1)) + 1) & Mid(sNewPassword, i + 1)
            If Asc(Mid(sCurrentPassword, i, 1)) <> MAX_CHAR Then
                Exit For
            End If
        Next i
    Else
        'do an increment on the rightmost character
        sNewPassword = Left(sCurrentPassword, Len(sCurrentPassword) - 1) & Chr(Asc(Right(sCurrentPassword, 1)) + 1)
    End If

    GenerateNextPassword = sNewPassword
End Function

这篇SO文章中演示的Hook方法每一次都适用。

https://stackoverflow.com/a/27508116/5757159

没有十六进制编辑器，没有下载，没有安装程序。只是一个纯VBA解决方案。