有时我们为了保护Excel文档,会给文档加上密码,如文档查看、只读密码,工作表、工作簿的保护密码等,但是时间久了难免忘记密码,这时就只好进行破解了。下面列举几种常用的破解Excel密码的方法,供各位参考。
首先我们要明确一个前提,不同类型的密码,破解方法是不一样的,有些密码可能是无法破解的;而Excel文档又分为不同版本(xls和xlsx),破解方法也有所不同。
温馨提示:破解密码前请先备份原文档。
1、文档查看、只读密码破解
Excel文档的查看、只读密码目前没有什么好的破解办法,只能采用暴力破解,就是指定一个规则,然后一个一个去试。如果你当初设置的密码足够复杂,那就不要做无所谓的挣扎了,建议及早放弃为好。但如果文档十分重要,不计代价也要破解密码,可以尝试一些网站的收费服务,但是不要抱太高的希望。
2、工作表、工作簿的保护密码
根据Excel文档版本不同,工作表、工作簿保护密码的破解方法也不太一样。
(1)xls文档破解方法
对于早期的xls文档(2003及以前),可以用VBA代码破解。
打开Excel文档,按Alt+F11进入“开发工具”界面,在左边的工程栏(Project)中选定节点“ThisWorkbook”,双击左键,然后把下面的代码复制到右边的代码编辑框中。然后按F5键执行代码开始破解,破解期间会出现两次提示的对话框,都选择“确认”。密码破解完毕之后会出现提示“该工作簿中的工作表密码保护已被全部解除”,这说明工作表或工作簿的保护密码已被成功清除。最后删除“ThisWorkbook”节点中的代码,保存工作表。至此,破解完成。
Public Sub 工作表保护密码破解() Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ "作者:McCormick JE McGimpsey " Const HEADER As String = "工作表保护密码破解" Const VERSION As String = DBLSPACE & "版本 Version 1.1.1" Const REPBACK As String = DBLSPACE & "" Const ZHENGLI As String = DBLSPACE & "" Const ALLCLEAR As String = DBLSPACE & "该工作簿中的工作表密码保护已全部解除!!" & DBLSPACE & "请记得另保存" _ & DBLSPACE & "注意:不要用在不当地方,要尊重他人的劳动成果!" Const MSGNOPWORDS1 As String = "该文件工作表中没有加密" Const MSGNOPWORDS2 As String = "该文件工作表中没有加密2" Const MSGTAKETIME As String = "解密需花费一定时间,请耐心等候!" & DBLSPACE & "按确定开始破解!" Const MSGPWORDFOUND1 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ "如果该文件工作表有不同密码,将搜索下一组密码并修改清除" Const MSGPWORDFOUND2 As String = "密码重新组合为:" & DBLSPACE & "$$" & DBLSPACE & _ "如果该文件工作表有不同密码,将搜索下一组密码并解除" Const MSGONLYONE As String = "确保为唯一的?" Dim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Application.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If MsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then Else On Error Resume Next Do 'dummy do loop 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 With ActiveWorkbook .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then MsgBox MSGONLYONE, vbInformation, HEADER Exit Sub End If On Error Resume Next For Each w1 In Worksheets 'Attempt clearance with PWord1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False For Each w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do 'Dummy do loop 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 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) MsgBox Application.Substitute(MSGPWORDFOUND2, _ "$$", PWord1), vbInformation, HEADER 'leverage finding Pword by trying on other sheets For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do 'Bypass all for...nexts End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If End With Next w1 End If MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK & ZHENGLI, vbInformation, HEADER End Sub
(2)xlsx文档破解方法
从2007版本以后,Excel文档的扩展名从xls变成了xlsx,文档结构也大变样。Xlsx文档本质上其实是一个压缩包,里面包含了许多xml文档,工作表、工作簿的保护密码就保存在这些xml文档中,我们可以用WinRAR等压缩工具将其解压,然后直接修改内容,就可以去掉工作表、工作簿的保护密码了。
具体方法如下:
将文档扩展名修改为zip或rar,然后将其解压。
在解压得到的文件中找到“xl”文件夹,双击打开,“workbook.xml”中即包含工作簿的保护密码,用记事本打开该文档,搜索“workbookProtection”,将带有“workbookProtection”的那一段代码删除即可。代码格式如:
workbookProtection workbookAlgorithmName="SHA-512" workbookHashValue="******" workbookSaltValue="******" workbookSpinCount="100000" lockStructure="1"
另外,“xl\worksheets”文件夹下的“sheet1.xml”、“sheet2.xml”中则保存了各工作表的密码,同样用记事本打开,搜索“sheetProtection”,将带有“sheetProtection”的那一段代码删除即可。
代码格式如:
sheetProtection algorithmName="SHA-512" hashValue="******" saltValue="******" spinCount="100000" sheet="1" formatCells="0" formatColumns="0" formatRows="0" insertColumns="0" insertRows="0" insertHyperlinks="0" deleteColumns="0" deleteRows="0" sort="0" autoFilter="0" pivotTables="0"
最后保存文件,重新压缩为zip格式(注意必须是zip,不能是rar或其他格式),然后把这个压缩包的后缀重新修改回xlsx。至此,破解完成。
有用
呜呜,感谢作者,刚才用了,亲测有效。
太厉害了~~~亲测有用