excel表格忘记密码怎么破解
时间:2022-02-13 17:18:56
一些有着重要的excel文件,工作表肯定会添加密码,但是有时会忘记密码,这是该如何破解呢?其实设置方法不难,小编有简单暴力的方法,下面随小编一起来看看excel表格破解工作表密码的方法,欢迎大家来到学习。
excel表格破解工作表密码的方法
打开excel工作表。
然后在Excel表中找到【视图】。
点开【宏】。
然后选择【录制宏】。
接着会弹出一个窗口,点击【确定】。
在此点开【宏】,点击【停止录制】。
然后再点击【宏】,弹出窗口点击【编辑】。
然后点击【模板1】,并清空右边红框里的代码,如下图。
然后把破解代码复制粘贴进入空白处(破解代码小编将在文章最底部分享给大家)。
然后在打开【查看宏】,点击执行破解代码。
会弹出一个框,是英文的,看不懂没关系,点击确定,解密需要一段时间。
12破解代码:
Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob McCormick
' probably originator of base code algorithm modified for coverage
' of workbook structure / windows passwords and for multiple passwords
'
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
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
MsgBox MSGNOPWORDS2, vbInformation, HEADER
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, vbInformation, HEADER
End Sub
猜你感兴趣:
1.excel忘记密码怎么破解
2.excel如何破解工作表密码
3.excel表设置密码后忘记了如何打开
4.Excel中出现密码忘记利用破解工具的操作方法
![](/images/zang.png)
![](/images/jiucuo.png)
猜你喜欢
右键新建没有Word怎么办
FineReport怎么制作滚动字幕?
![](https://img.aspxhome.com/file/2023/7/15177_0s.png)
iOS 15 小技巧:播放语音备忘录可自动跳过无声片段
![](https://img.aspxhome.com/file/2023/0/45600_0s.png)
Win10如何关闭杜比音效?Win10关闭杜比音效的方法
![](https://img.aspxhome.com/file/2023/2/46412_0s.png)
Excel自动换行方法
Word表格怎么转换成文字 word没保存怎么恢复
![](https://img.aspxhome.com/file/2023/1/24711_0s.png)
Word技巧:文章的分栏
如何使用excel2010趋势线与误差线分析图表的具体方法
![](https://img.aspxhome.com/file/2023/2/a141402_0s.jpg)
Word文档打开时速度慢
excel表格去掉数据小数点的方法
win101903怎么进入安全模式?win101903进入安全模式方法
![](https://img.aspxhome.com/file/2023/6/48026_0s.jpg)
Win10如何开启HDR功能?Win10开启HDR功能的方法
![](https://img.aspxhome.com/file/2023/1/52301_0s.jpg)
Excel 2013是怎么调用VBA的
![](https://img.aspxhome.com/file/2023/2/a142792_0s.jpg)
word中插入树状图的两种方法
win10蓝屏错误代码CRITICAL_STRUCTURE_CORRUPTION怎么解决
![](https://img.aspxhome.com/file/2023/2/49202_0s.jpg)
excel表格身份证号显示不全怎么办
Word 2019符号快捷方式
Win10专业版提示该文件没有与之关联的程序来执行该操作要怎么办?
![](https://img.aspxhome.com/file/2023/7/49607_0s.png)
iOS15.5 Beta 3更新内容及升级方法
![](https://img.aspxhome.com/file/2023/2/45462_0s.png)
Word如何取消超链接
![](https://img.aspxhome.com/file/2023/4/34424_0s.gif)