我忘记了打开 Word 文档的密码。如何找回密码？

Question

我有一个word文档提示用户输入密码才能打开，对话框如下图。

"Enter Password to open file" 

我发现了一些使用暴力破解密码的代码，如下所示（使用 Excel 编写）。唯一的问题是当我使用 Documents.Open 时，如果密码错误的话会显示对话框 - 有没有办法解决这个问题？

Private Sub PasswordBreakerWord()
'Author unknown but submitted by brettdj of www.experts-exchange.com


Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim strPath As String
Dim passAtmp As String

strPath = "H:\My_Path\"

Set objWord = CreateObject("word.Application")
objWord.Visible = True

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

  passAtmp = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

 On Error Resume Next
  Set objDoc = objWord.Documents.Open(Filename:=strPath & "High Yield FMA Procedures.doc", PasswordTemplate:=passAtmp)
 If Err <> 0 Then
    On Error GoTo 0
 Else
    MsgBox "password is: " & passAtmp
    Debug.Print passAtmp
    Exit Sub
End If

Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

Set objWord = Nothing

End Sub

Answer 1

文件需要为.docx格式，如果是.doc则转换为.docx：

1. 创建文件的备份副本。
2. 将扩展名从 .docx 更改为 .zip。
3. 打开新的.zip 文件并解压所有文件。
4. 在提取的文件夹中转到word\settings.xml。
5. 打开 settings.xml 并将代码从 <w:documentProtection 删除到 /> 并保存文件。
6. 将新的settings.xml 复制到原.zip 文件并覆盖旧文件。
7. 将.zip 重命名为.docx 并打开现在免费保护的文件！

Answer 2

在尝试打开文件之前立即使用SendKeys "{ESC}"。

Answer 3

正如“Matt”所说，只需将文件扩展名转换为 .zip，然后使用记事本或 notepad++ 编辑 .xml 文件，删除 w:documentprotection 之后的整行到 />，然后重新保存新的 .xml 文件.zip 文件夹中的内容将删除密码保护。在 Word 2016 中进行了尝试和测试。只是不要忘记将现在编辑的 zip 文件夹重命名为 .docx，以便它在 Word 中可读。全部归功于马特。

Answer 4

我调整了您的原始代码，因此它不依赖于密码的一定长度。此外，它现在将从左向右移动，每次通过时添加一个新字符，并在尝试打开文档时防止弹出窗口。这也可以用于工作簿。

警告** 蛮力方法真的不值得。运行需要很长时间。如果是加密密码，那么这可能是最好的选择，无需下载第三方密码破解器。

Sub PasswordBreakerWord()
Dim WordApp As Object
Dim WordDoc As Object
Dim strPath As String
Dim passAtmp As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set WordApp = CreateObject("Word.Application")
Set WordDoc = CreateObject("Word.Document")
strPath = Environ("USERPROFILE") & "\Desktop\blah.docx"

Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
Dim i7 As Integer, i8 As Integer, i9 As Integer
Dim i10 As Integer, i11 As Integer, i12 As Integer

For i1 = 31 To 126: For i2 = 31 To 126: For i3 = 31 To 126
For i4 = 31 To 126: For i5 = 31 To 126: For i6 = 31 To 126
For i7 = 31 To 126: For i8 = 31 To 126: For i9 = 31 To 126
For i10 = 31 To 126: For i11 = 31 To 126: For i12 = 31 To 126

passAtmp = Chr(i12) & Chr(i11) & Chr(i10) & Chr(i9) & Chr(i8) & Chr(i7) & Chr(i6) & Chr(i5) & Chr(i4) & Chr(i3) & Chr(i2) & Chr(i1)
Debug.Print passAtmp

On Error Resume Next
Set WordDoc = WordApp.Documents.Open(strPath, , True, , passAtmp)
If Err <> 0 Then
    On Error GoTo 0
Else
    MsgBox "password is: " & passAtmp
    Debug.Print passAtmp
    WordApp.Quit
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
    Exit Sub
End If

Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub