擅长保护密码是用来防止别人修改擅长文档用的，但有时连自己都忘了，那该怎么办呢？

破解方法：

打开需要破解的擅长文档，然后按Alt F11打开VBA编辑器，点击插入-模块，在模块中将以下代码复制进去，无需保存，直接按F5运行，等待运行完毕。大约等待2分钟左右，密码被计算出来，并且显示出原密码，文档也变成未设密码状态。

（注：复制代码时按下面代码区域右上角的第二个按钮。)

' Public Sub AllInternalPasswords()'断开工作表和工作簿结构密码鲍勃麦考密克可能是为覆盖工作簿结构/窗口密码和多重密码而修改的基本代码算法的创始人诺曼哈克和JE麦克金普西2002年12月27日（版本1.1)' '由JEM:于2003年四月四日修改所有味精为常量，和"消除一个退出子（版本1.1.1)"显示哈希密码非原始密码Const DBLSPACE As String=vbNewLine vbNewLine Const AUTHORS As String=DBLSPACE vbNewLine _”改编自鲍勃麦考密克基本代码，作者为“_”诺曼哈克和JE麦克金普西" Const HEADER As String=" alliternalpasswords "用户消息"常量版本字符串=数据库空间"版本1 .1 .1 2003-4-04“Const REPBACK As String=DBLSPACE”请报告失败' Const ALLCLEAR As String=DBLSPACE '工作簿现在应该' _ '没有任何密码保护，所以请确保您：' _DBLSPACE '立即保存它!'" DBLSPACE "和" _ DBLSPACE"BACKUP！备份！备份！_ DBLSPACE '另外，请记住，密码放在那里是有原因的。不要填充关键公式' _ '或数据DBLSPACE”访问和使用某些数据"可能是一种违法行为。如果有疑问，不要常量MSGNOPWORDS1为字符串='在' _ '工作表，工作簿结构或窗口中没有密码'作者版本onst msgnopowords 2 As String='对' _ '工作簿结构或窗口没有保护''继续取消工作表保护'作者版本在按下"确定"按钮后，此"_"将需要一些时间

& 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 & VERSIONConst 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 & VERSIONConst 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 & VERSIONConst MSGONLYONE As String = "Only structure / windows " & _"protected with the password that was just found." & _ALLCLEAR & AUTHORS & VERSION & REPBACKDim w1 As Worksheet, w2 As WorksheetDim i As Integer, j As Integer, k As Integer, l As IntegerDim m As Integer, n As Integer, i1 As Integer, i2 As IntegerDim i3 As Integer, i4 As Integer, i5 As Integer, i6 As IntegerDim PWord1 As StringDim ShTag As Boolean, WinTag As BooleanApplication.ScreenUpdating = FalseWith ActiveWorkbookWinTag = .ProtectStructure Or .ProtectWindowsEnd WithShTag = FalseFor Each w1 In WorksheetsShTag = ShTag Or w1.ProtectContentsNext w1If Not ShTag And Not WinTag ThenMsgBox MSGNOPWORDS1, vbInformation, HEADERExit SubEnd IfMsgBox MSGTAKETIME, vbInformation, HEADERIf Not WinTag ThenMsgBox MSGNOPWORDS2, vbInformation, HEADERElseOn Error Resume NextDo 'dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126With 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 ThenPWord1 = 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, HEADERExit Do 'Bypass all for...nextsEnd IfEnd WithNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfIf WinTag And Not ShTag ThenMsgBox MSGONLYONE, vbInformation, HEADERExit SubEnd IfOn Error Resume NextFor Each w1 In Worksheets'Attempt clearance with PWord1w1.Unprotect PWord1Next w1On Error GoTo 0ShTag = FalseFor Each w1 In Worksheets'Checks for all clear ShTag triggered to 1 if not.ShTag = ShTag Or w1.ProtectContentsNext w1If ShTag ThenFor Each w1 In WorksheetsWith w1If .ProtectContents ThenOn Error Resume NextDo 'Dummy do loopFor i = 65 To 66: For j = 65 To 66: For k = 65 To 66For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66For 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 ThenPWord1 = 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 sheetsFor Each w2 In Worksheetsw2.Unprotect PWord1Next w2Exit Do 'Bypass all for...nextsEnd IfNext: Next: Next: Next: Next: NextNext: Next: Next: Next: Next: NextLoop Until TrueOn Error GoTo 0End IfEnd WithNext w1End IfMsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADEREnd Sub

破解如此简单。有了这个方法，那Excel文档保护功能就是形同虚设。

【测试使用Excel2003版本，通过。】