To Get all Internal Passwords of Protected Excel

All, It Happen some times that we may forgot the password of the excel. we realize that when we about to perform some changes in the excel sheet and it will pop up with the message that this workbook is protected. I have something interested to remove all passwords from the Excel workbook. This will work only when you can open the workbook. To remove all password from the workbook follow the steps give below: Make new worksheet Named as Internal Password and save it as Macro Enable worksheet ( For office 2007) Open the worksheet you have created just now. Press Ctr + F11 to open VBA project window Go to Insert  > Select Module On the right hand side new page will open Copy below give Macro in the page Option Explicit Public Sub InternalPasswords()     ' Breaks worksheet and workbook structure passwords.     'Ankur Mishra http://allhelpavailable.blogspot.com         Const DBLSPACE As String = vbNewLine & vbNewLine     Const AUTHORS As String = DBLSPACE & vbNewLine & _             " Code Prepared only for Help Not for Hacking " & _             " By Ankur Mishra"     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 Save the Module Close VBA project Window Save workbook. Now the workbook is ready to remove all password from the Excel. To run this Macro: 1.      Open the Workbook you have just created (Internal Password.xlsm) 2.      Open the workbook for which you want to get all internal password. 3.      Click Ctr + F8 4.      window will appear having option to run Macro 5.      Select Macro and Click Run This will take some time depends on the length of Password and your computer respond speed.