| Excel打开密码及保护密码破解的方法 | 您所在的位置：网站首页 › xlsx工作表密码破解 › Excel打开密码及保护密码破解的方法 |
|
打开密码： 新开一Excel，同时按Alt+F11，进入VBA界面，点菜单上的插入，模块，在新出来的窗口粘贴一下代码： Sub crack() Dim i As Long Dim FileName As String i = 0 FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xlsx）,*.xls;*.xlsx", , "VBA破解") FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\")) Application.ScreenUpdating = False line2: On Error GoTo line1 Workbooks.Open FileName, , True, , i MsgBox "Password is " & i Exit Sub line1: i = i + 1 Resume line2 Application.ScreenUpdating = True End Sub然后在当前界面，按F5运行此宏，然后选择文件加密需要破解的EXCEL开始进行破解，这个破解速度是看你的密码对的长度、复杂程度、电脑配置。这里测试的密码是 [12] ，秒破。 打开密码破解文章来源：https://blog.csdn.net/qq_22903531/article/details/83410527-----------------------------------------------保护密码： 1、先打开有保护密码的Excel文件。 2、新建一个宏（一般都在"视图"页签中）。 3、点击录制宏。 4、点击停止录制。 5、选新建的宏，点编辑。 6、删除所有原内容，替换成框内代码，然后直接关闭VBA窗口，不必保存。 Public Sub Password_cracking() Const DBLSPACE As String = vbNewLine & vbNewLine Const HEADER As String = "Password_cracking" Const VERSION As String = DBLSPACE & " Version 1.0" Const REPBACK As String = DBLSPACE & "" Const ZHENGLI As String = DBLSPACE & "" Const ALLCLEAR As String = DBLSPACE & "All password is clear" & DBLSPACE & "Please remember to save" Const MSGNOPWORDS1 As String = "No password!" Const MSGNOPWORDS2 As String = "No password!" Const MSGTAKETIME As String = "This will take some time , please wait for a while" & DBLSPACE & "Press next to start" Const MSGPWORDFOUND1 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _ "If the file worksheet has a different password, it will search for the next set of passwords and release" Const MSGPWORDFOUND2 As String = "Password is : " & DBLSPACE & "$$" & DBLSPACE & _ "If the file worksheet has a different password, it will search for the next set of passwords and release" 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 Sub7、宏名称会变成“Password_cracking”。 8、选中这个宏，点击执行即可。 保护密码破解原文链接：https://blog.csdn.net/jnxxhzz/article/details/81673107 |
| CopyRight 2018-2019 实验室设备网 版权所有 |