我忘记了打开 Word 文档的密码。我怎样才能找回密码?

I forgot the password to open a Word document. How can I retrieve the password?

我有一个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

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

文件需要是.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 并打开现在不受保护的文件!

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

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

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

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