This has been floating around for a while now, but I gave it a serious reworking.

Option Explicit
Public Sub AllInternalPasswords()
On Error Resume Next
'
' 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)
'
' Modified 5/7/2013 by KTH: Application.Substitute changed
' to Replace (Version 1.1.2) All integers and bools declared on one line (were
' declared individually) Layout changed, easier to read and edit
' screenupdating reenabled at end of sub
' Not wsProc And Not wbProc changed to Not (wsProc or wbProc)
' dummy do loops replaced with gotos
' some conditions now checked within if-else of pass loops
' to avoid redundancy
' complicated error checking changed to one resume next
' remove if program does not work and observe errors
' integer loop + Chr(integer) changed to for each loop through
' array of letters. should be faster
' layout changed back, still excruciatingly difficult to read
' integers should have been byte data type, since loop values were small
' doesnt matter now anyways, changed to for each
' changed to one loop unprotecting workbook and worksheets
' should be faster overall
' I actually found a use for Xor!
' overall it doesnt seem faster, but having removed
' 12 loops it seems unlikely that it's not
' worst case it takes about 13 seconds now on a good PC
' removed some of the pointlessly descriptive constants
' (like no workbook passes but there are worksheets passes
' proceeding to unprotect worksheets) very wordy and
' not important enough to add extra if conditions for
' changed to python-style layout, sorry if it bothers you
' but it's easier to read
'
' Reveals hashed passwords NOT original passwords
'
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & _
"Adapted from Bob McCormick base code by " & _
"Norman Harker and JE McGimpsey " & DBLSPACE & _
"Modified: JEM 4/4/2004 " & DBLSPACE & "Modified: Kyle Hooks 5/7/2013"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.2 2013-May-07"
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 MSGNOPWORDS As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & 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 Workbook " & _
"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

Dim m As Byte
Dim AB(1) As String: AB(0) = "A": AB(1) = "B"
Dim MoreLetters() As String

For m = 32 To 126
ReDim Preserve MoreLetters(m - 32)
MoreLetters(m - 32) = Chr(m): Next

Dim wa, wb As Worksheet
Dim a, b, c, d, e, f, g, h, i, j, k, l As Variant
Dim pWord As String
Dim wsProc, wbProc, wsFound, wbFound As Boolean

wsFound = False: wbFound = False

Application.ScreenUpdating = False

With ActiveWorkbook: wbProc = .ProtectStructure Or .ProtectWindows: End With

wsProc = False
For Each wb In Worksheets: wsProc = wsProc Or wb.ProtectContents: Next

If Not (wsProc Or wbProc) Then
MsgBox MSGNOPWORDS, vbInformation, HEADER
Exit Sub: End If

MsgBox MSGTAKETIME, vbInformation, HEADER

For Each a In AB: For Each b In AB: For Each c In AB: For Each d In AB: For Each e In AB: For Each f In AB
For Each g In AB: For Each h In AB: For Each i In AB: For Each j In AB: For Each k In AB: For Each l In MoreLetters
If wbFound Xor wbProc Then ' only returns true if not equal, in this case only if the wb is protected and the pass is not found
With ActiveWorkbook
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not (.ProtectStructure Or .ProtectWindows) Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND1, "$$", pWord), vbInformation, HEADER
wbFound = True: End If: End With: End If
If wsFound Xor wsProc Then
For Each wa In Worksheets
With wa
If .ProtectContents Then
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not .ProtectContents Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND2, "$$", pWord), vbInformation, HEADER
wsFound = True: End If: End If: End With: Next: End If
If Not ((wbFound Xor wbProc) Or (wsFound Xor wsProc)) Then: GoTo finalize
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
finalize:
Application.ScreenUpdating = True
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub

Here's a good one, with a few extra options:
http://www.EXCELGAARD.dk/Lib/Password%20Cracker/

CE


Den 07.05.2013 16:36, skrev:
This has been floating around for a while now, but I gave it a serious reworking.

Option Explicit
Public Sub AllInternalPasswords()
On Error Resume Next
'
' 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)
'
' Modified 5/7/2013 by KTH: Application.Substitute changed
' to Replace (Version 1.1.2) All integers and bools declared on one line (were
' declared individually) Layout changed, easier to read and edit
' screenupdating reenabled at end of sub
' Not wsProc And Not wbProc changed to Not (wsProc or wbProc)
' dummy do loops replaced with gotos
' some conditions now checked within if-else of pass loops
' to avoid redundancy
' complicated error checking changed to one resume next
' remove if program does not work and observe errors
' integer loop + Chr(integer) changed to for each loop through
' array of letters. should be faster
' layout changed back, still excruciatingly difficult to read
' integers should have been byte data type, since loop values were small
' doesnt matter now anyways, changed to for each
' changed to one loop unprotecting workbook and worksheets
' should be faster overall
' I actually found a use for Xor!
' overall it doesnt seem faster, but having removed
' 12 loops it seems unlikely that it's not
' worst case it takes about 13 seconds now on a good PC
' removed some of the pointlessly descriptive constants
' (like no workbook passes but there are worksheets passes
' proceeding to unprotect worksheets) very wordy and
' not important enough to add extra if conditions for
' changed to python-style layout, sorry if it bothers you
' but it's easier to read
'
' Reveals hashed passwords NOT original passwords
'
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & _
"Adapted from Bob McCormick base code by " & _
"Norman Harker and JE McGimpsey " & DBLSPACE & _
"Modified: JEM 4/4/2004 " & DBLSPACE & "Modified: Kyle Hooks 5/7/2013"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.2 2013-May-07"
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 MSGNOPWORDS As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & 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 Workbook " & _
"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

Dim m As Byte
Dim AB(1) As String: AB(0) = "A": AB(1) = "B"
Dim MoreLetters() As String

For m = 32 To 126
ReDim Preserve MoreLetters(m - 32)
MoreLetters(m - 32) = Chr(m): Next

Dim wa, wb As Worksheet
Dim a, b, c, d, e, f, g, h, i, j, k, l As Variant
Dim pWord As String
Dim wsProc, wbProc, wsFound, wbFound As Boolean

wsFound = False: wbFound = False

Application.ScreenUpdating = False

With ActiveWorkbook: wbProc = .ProtectStructure Or .ProtectWindows: End With

wsProc = False
For Each wb In Worksheets: wsProc = wsProc Or wb.ProtectContents: Next

If Not (wsProc Or wbProc) Then
MsgBox MSGNOPWORDS, vbInformation, HEADER
Exit Sub: End If

MsgBox MSGTAKETIME, vbInformation, HEADER

For Each a In AB: For Each b In AB: For Each c In AB: For Each d In AB: For Each e In AB: For Each f In AB
For Each g In AB: For Each h In AB: For Each i In AB: For Each j In AB: For Each k In AB: For Each l In MoreLetters
If wbFound Xor wbProc Then ' only returns true if not equal, in this case only if the wb is protected and the pass is not found
With ActiveWorkbook
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not (.ProtectStructure Or .ProtectWindows) Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND1, "$$", pWord), vbInformation, HEADER
wbFound = True: End If: End With: End If
If wsFound Xor wsProc Then
For Each wa In Worksheets
With wa
If .ProtectContents Then
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not .ProtectContents Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND2, "$$", pWord), vbInformation, HEADER
wsFound = True: End If: End If: End With: Next: End If
If Not ((wbFound Xor wbProc) Or (wsFound Xor wsProc)) Then: GoTo finalize
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
finalize:
Application.ScreenUpdating = True
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub

heheh...well the add-ins a bit much tbh, kind of overkill.

I would be more interested in knowing whether or not my code is faster, a pretty front-end doesn't make it better.

What if you're cracking a workbook of 210 spreadsheets? (we have some of those here) you dont want something pretty, you want something fast.

For Each wb In Worksheets
wb.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If wb.ProtectContents Then: wsFound = False
Next

you have to add this into the worksheets loop for it to find all worksheet passwords

For Each wb In Worksheets
wb.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
wsFound = wsFound Or wb.ProtectContents
Next

add this to worksheets loop to unprotect all

heheh...well the add-ins a bit much tbh, kind of overkill.

I would be more interested in knowing whether or not my code is
faster, a pretty front-end doesn't make it better.

But it does make it more convenient and configurable! That's worth
something on its own!

Did you try Charlotte's suggestion and time it?

What if you're cracking a workbook of 210 spreadsheets? (we have some
of those here) you dont want something pretty, you want something
fast.

I use 3rd party software to remove passwords without opening the
file[s] in Excel. It removes FileOpen, Sheet, Workbook, and VBA
passwords in the blink of an eye!

I have the original VBA from Dempsey, though, and I'll do a performance
test on yours/theirs when I get time so I can compare this to my 3rd
party utility. I'll include timing Charlottes xla too!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

use this version for the speed test...i think its the fastest

Option Explicit

Public Sub AllInternalPasswords()
On Error Resume Next

Dim wa, wb As Worksheet
Dim a, b, c, d, e, f, g, h, i, j, k, l As Long 'avoid conversion in Chr()
Dim pWord As String
Dim wsProc, wbProc As Boolean

Application.ScreenUpdating = False

With ActiveWorkbook: wbProc = .ProtectStructure Or .ProtectWindows: End With

wsProc = False
For Each wb In Worksheets: wsProc = wsProc Or wb.ProtectContents: Next

For a = 65 To 66: For b = 65 To 66: For c = 65 To 66: For d = 65 To 66: For e = 65 To 66: For f = 65 To 66
For g = 65 To 66: For h = 65 To 66: For i = 65 To 66: For j = 65 To 66: For k = 65 To 66: For l = 32 To 126
If wbProc Then
With ActiveWorkbook
.Unprotect Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j) & Chr(k) & Chr(l)
If Not (.ProtectStructure Or .ProtectWindows) Then
pWord = Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j) & Chr(k) & Chr(l)
wbProc = False: End If: End With: End If
If wsProc Then
For Each wa In Worksheets
With wa
If .ProtectContents Then
.Unprotect Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j) & Chr(k) & Chr(l)
If Not .ProtectContents Then
pWord = Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j) & Chr(k) & Chr(l)
For Each wb In Worksheets
wb.Unprotect pWord
wsProc = wsProc Or wb.ProtectContents: Next
End If: End If: End With: Next
Else
If Not wbProc Then: GoTo finalize
End If
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
finalize:
Application.ScreenUpdating = True
End Sub

or this, i cant tell which is faster

Option Explicit

Public Sub AllInternalPasswords()
On Error Resume Next

Dim AB(1) As String: AB(0) = "A": AB(1) = "B"
Dim MoreLetters() As String

Dim m As Byte
For m = 32 To 126
ReDim Preserve MoreLetters(m - 32)
MoreLetters(m - 32) = Chr(m): Next

Dim wa, wb As Worksheet
Dim a, b, c, d, e, f, g, h, i, j, k, l As Variant
Dim pWord As String
Dim wsProc, wbProc As Boolean

Application.ScreenUpdating = False

With ActiveWorkbook: wbProc = .ProtectStructure Or .ProtectWindows: End With

wsProc = False
For Each wb In Worksheets: wsProc = wsProc Or wb.ProtectContents: Next

For Each a In AB: For Each b In AB: For Each c In AB: For Each d In AB: For Each e In AB: For Each f In AB
For Each g In AB: For Each h In AB: For Each i In AB: For Each j In AB: For Each k In AB: For Each l In MoreLetters
If wbProc Then
With ActiveWorkbook
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not (.ProtectStructure Or .ProtectWindows) Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
wbProc = False: End If: End With: End If
If wsProc Then
For Each wa In Worksheets
With wa
If .ProtectContents Then
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not .ProtectContents Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
For Each wb In Worksheets
wb.Unprotect pWord
wsProc = wsProc Or wb.ProtectContents: Next
End If: End If: End With: Next
Else
If Not wbProc Then: GoTo finalize
End If
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
finalize:
Application.ScreenUpdating = True
End Sub

the original will be faster when there are no protected workbooks, or no protected sheets, i believe.

hi

Get MS Excel Password cracker software which fully helps you to crack excel password and then you can open locked excel file easily............

Open this link - http://www.excelpasswordcracker.com

Excel Security Unlock software is best tool to swiftly and simply recover excel protection then you can open excel file with complete security. With the assist of this software you can naturally break, crack of unlock locked excel file just few mouse of clicks. Excel security unlocker tool to resolution all problems of excel file.

Read mo
http://www.excelunlocker.com

http://www.ms.recoveryexcelpassword.com/

If you unable to access your Excel file data reason of you forget your Excel Spreadsheet password then immediately download Excel password unlocker tool which help you to unlock XLS spreadsheet with original excel file password. Excel password recovery tool excellent key for those users who want to remove and unlock excel file password.

Read mo
http://www.excel2007passwordrecovery.com

https://www.facebook.com/unlockexcelpassword

Excel password remover tool is recover your lost excel password and unlock locked excel file then you can re-access your excel spreadsheet without creating any problem. Through this software excel users can immediately crack excel file password and unprotect password protected excel file with advance technology.

Read mo
http://www.excelpassword.net

http://www.unlockexcelpassword.com

This is quite impossible to open locked Excel sheet without putting password on it but now this is possible with ease by using eSoftTools Excel password breaker software. With the help of this application users can open locked Excel file even if they forgot their spreadsheet password.

Read More
http://www.excelpasswordrecovery.esofttools.com/

This is possible to effortlessly unlock Excel file by removing password security with the help of eSoftTools Excel file password recovery software. This is advanced Excel password cracker tool which supports all Excel versions and unlock xls, xlsx, xlsm, xltm, xla, xlam and xlsb file effortlessly.

Read More
http://www.esofttools.com/excel-password-recovery.html

On Tuesday, May 7, 2013 at 7:36:26 PM UTC+5, A Guy wrote:
This has been floating around for a while now, but I gave it a serious reworking.

Option Explicit
Public Sub AllInternalPasswords()
On Error Resume Next
'
' 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)
'
' Modified 5/7/2013 by KTH: Application.Substitute changed
' to Replace (Version 1.1.2) All integers and bools declared on one line (were
' declared individually) Layout changed, easier to read and edit
' screenupdating reenabled at end of sub
' Not wsProc And Not wbProc changed to Not (wsProc or wbProc)
' dummy do loops replaced with gotos
' some conditions now checked within if-else of pass loops
' to avoid redundancy
' complicated error checking changed to one resume next
' remove if program does not work and observe errors
' integer loop + Chr(integer) changed to for each loop through
' array of letters. should be faster
' layout changed back, still excruciatingly difficult to read
' integers should have been byte data type, since loop values were small
' doesnt matter now anyways, changed to for each
' changed to one loop unprotecting workbook and worksheets
' should be faster overall
' I actually found a use for Xor!
' overall it doesnt seem faster, but having removed
' 12 loops it seems unlikely that it's not
' worst case it takes about 13 seconds now on a good PC
' removed some of the pointlessly descriptive constants
' (like no workbook passes but there are worksheets passes
' proceeding to unprotect worksheets) very wordy and
' not important enough to add extra if conditions for
' changed to python-style layout, sorry if it bothers you
' but it's easier to read
'
' Reveals hashed passwords NOT original passwords
'
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & _
"Adapted from Bob McCormick base code by " & _
"Norman Harker and JE McGimpsey " & DBLSPACE & _
"Modified: JEM 4/4/2004 " & DBLSPACE & "Modified: Kyle Hooks 5/7/2013"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.2 2013-May-07"
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 MSGNOPWORDS As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & 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 Workbook " & _
"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

Dim m As Byte
Dim AB(1) As String: AB(0) = "A": AB(1) = "B"
Dim MoreLetters() As String

For m = 32 To 126
ReDim Preserve MoreLetters(m - 32)
MoreLetters(m - 32) = Chr(m): Next

Dim wa, wb As Worksheet
Dim a, b, c, d, e, f, g, h, i, j, k, l As Variant
Dim pWord As String
Dim wsProc, wbProc, wsFound, wbFound As Boolean

wsFound = False: wbFound = False

Application.ScreenUpdating = False

With ActiveWorkbook: wbProc = .ProtectStructure Or .ProtectWindows: End With

wsProc = False
For Each wb In Worksheets: wsProc = wsProc Or wb.ProtectContents: Next

If Not (wsProc Or wbProc) Then
MsgBox MSGNOPWORDS, vbInformation, HEADER
Exit Sub: End If

MsgBox MSGTAKETIME, vbInformation, HEADER

For Each a In AB: For Each b In AB: For Each c In AB: For Each d In AB: For Each e In AB: For Each f In AB
For Each g In AB: For Each h In AB: For Each i In AB: For Each j In AB: For Each k In AB: For Each l In MoreLetters
If wbFound Xor wbProc Then ' only returns true if not equal, in this case only if the wb is protected and the pass is not found
With ActiveWorkbook
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not (.ProtectStructure Or .ProtectWindows) Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND1, "$$", pWord), vbInformation, HEADER
wbFound = True: End If: End With: End If
If wsFound Xor wsProc Then
For Each wa In Worksheets
With wa
If .ProtectContents Then
.Unprotect a & b & c & d & e & f & g & h & i & j & k & l
If Not .ProtectContents Then
pWord = a & b & c & d & e & f & g & h & i & j & k & l
MsgBox Replace(MSGPWORDFOUND2, "$$", pWord), vbInformation, HEADER
wsFound = True: End If: End If: End With: Next: End If
If Not ((wbFound Xor wbProc) Or (wsFound Xor wsProc)) Then: GoTo finalize
Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next: Next
finalize:
Application.ScreenUpdating = True
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub

not working in Excel 2016