Excel 工作表，单元格破解密码宏

  1 ' 1、 打开要破解的EXCEL文件|
  2
  3 ' 2、 工具---宏----录制新宏---输入名字如:aa -----关闭
  4
  5 ' 3、 工具---宏----停止录制(这样得到一个空宏)
  6
  7 ' 4、 工具---宏----宏,选aa,点 编辑 按钮
  8
  9 ' 5、 删除窗口中的所有字符(只有几个),替换为下面解压后文件中内容
 10
 11 ' Excel密码破解.rar
 12
 13 ' 6、关闭编辑窗口
 14
 15 ' 7、工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!
 16
 17
 18
 19
 20
 21
 22 Option   Explicit  
 23
 24 Public   Sub  AllInternalPasswords() 
 25 '  Breaks worksheet and workbook structure passwords. Bob McCormick 
 26 '  probably originator of base code algorithm modified for coverage 
 27 '  of workbook structure / windows passwords and for multiple passwords 
 28 '  
 29 '  Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) 
 30 '  Modified 2003-Apr-04 by JEM: All msgs to constants, and 
 31 '  eliminate one Exit Sub (Version 1.1.1) 
 32 '  Reveals hashed passwords NOT original passwords 
 33 Const  DBLSPACE  As   String   =  vbNewLine  &  vbNewLine 
 34 Const  AUTHORS  As   String   =  DBLSPACE  &  vbNewLine  &  _ 
 35 " Adapted from Bob McCormick base code by "   &  _ 
 36 " Norman Harker and JE McGimpsey "  
 37 Const  HEADER  As   String   =   " AllInternalPasswords User Message "  
 38 Const  VERSION  As   String   =  DBLSPACE  &   " Version 1.1.1 2003-Apr-04 "  
 39 Const  REPBACK  As   String   =  DBLSPACE  &   " Please report failure  "   &  _ 
 40 " to the microsoft.public.excel.programming newsgroup. "  
 41 Const  ALLCLEAR  As   String   =  DBLSPACE  &   " The workbook should  "   &  _ 
 42 " now be free of all password protection, so make sure you: "   &  _ 
 43 DBLSPACE  &   " SAVE IT NOW! "   &  DBLSPACE  &   " and also "   &  _ 
 44 DBLSPACE  &   " BACKUP!, BACKUP!!, BACKUP!!! "   &  _ 
 45 DBLSPACE  &   " Also, remember that the password was  "   &  _ 
 46 " put there for a reason. Don't stuff up crucial formulas  "   &  _ 
 47 " or data. "   &  DBLSPACE  &   " Access and use of some data  "   &  _ 
 48 " may be an offense. If in doubt, don't. "  
 49 Const  MSGNOPWORDS1  As   String   =   " There were no passwords on  "   &  _ 
 50 " sheets, or workbook structure or windows. "   &  AUTHORS  &  VERSION 
 51 Const  MSGNOPWORDS2  As   String   =   " There was no protection to  "   &  _ 
 52 " workbook structure or windows. "   &  DBLSPACE  &  _ 
 53 " Proceeding to unprotect sheets. "   &  AUTHORS  &  VERSION 
 54 Const  MSGTAKETIME  As   String   =   " After pressing OK button this  "   &  _ 
 55 " will take some time. "   &  DBLSPACE  &   " Amount of time  "   &  _ 
 56 " depends on how many different passwords, the  "   &  _ 
 57 " passwords, and your computer's specification. "   &  DBLSPACE  &  _ 
 58 " Just be patient! Make me a coffee! "   &  AUTHORS  &  VERSION 
 59 Const  MSGPWORDFOUND1  As   String   =   " You had a Worksheet  "   &  _ 
 60 " Structure or Windows Password set. "   &  DBLSPACE  &  _ 
 61 " The password found was:  "   &  DBLSPACE  &   " $$ "   &  DBLSPACE  &  _ 
 62 " Note it down for potential future use in other workbooks by  "   &  _ 
 63 " the same person who set this password. "   &  DBLSPACE  &  _ 
 64 " Now to check and clear other passwords. "   &  AUTHORS  &  VERSION 
 65 Const  MSGPWORDFOUND2  As   String   =   " You had a Worksheet  "   &  _ 
 66 " password set. "   &  DBLSPACE  &   " The password found was:  "   &  _ 
 67 DBLSPACE  &   " $$ "   &  DBLSPACE  &   " Note it down for potential  "   &  _ 
 68 " future use in other workbooks by same person who  "   &  _ 
 69 " set this password. "   &  DBLSPACE  &   " Now to check and clear  "   &  _ 
 70 " other passwords. "   &  AUTHORS  &  VERSION 
 71 Const  MSGONLYONE  As   String   =   " Only structure / windows  "   &  _ 
 72 " protected with the password that was just found. "   &  _ 
 73 ALLCLEAR  &  AUTHORS  &  VERSION  &  REPBACK 
 74 Dim  w1  As  Worksheet, w2  As  Worksheet 
 75 Dim  i  As   Integer , j  As   Integer , k  As   Integer , l  As   Integer  
 76 Dim  m  As   Integer , n  As   Integer , i1  As   Integer , i2  As   Integer  
 77 Dim  i3  As   Integer , i4  As   Integer , i5  As   Integer , i6  As   Integer  
 78 Dim  PWord1  As   String  
 79 Dim  ShTag  As   Boolean , WinTag  As   Boolean  
 80
 81 Application.ScreenUpdating  =   False  
 82 With  ActiveWorkbook 
 83 WinTag  =  .ProtectStructure  Or  .ProtectWindows 
 84 End   With  
 85 ShTag  =   False  
 86 For   Each  w1 In Worksheets 
 87 ShTag  =  ShTag  Or  w1.ProtectContents 
 88 Next  w1 
 89 If   Not  ShTag  And   Not  WinTag  Then  
 90 MsgBox  MSGNOPWORDS1, vbInformation, HEADER 
 91 Exit   Sub  
 92 End   If  
 93 MsgBox  MSGTAKETIME, vbInformation, HEADER 
 94 If   Not  WinTag  Then  
 95 MsgBox  MSGNOPWORDS2, vbInformation, HEADER 
 96 Else  
 97 On   Error   Resume   Next  
 98 Do   ' dummy do loop 
 99 For  i  =   65   To   66 :  For  j  =   65   To   66 :  For  k  =   65   To   66  
100 For  l  =   65   To   66 :  For  m  =   65   To   66 :  For  i1  =   65   To   66  
101 For  i2  =   65   To   66 :  For  i3  =   65   To   66 :  For  i4  =   65   To   66  
102 For  i5  =   65   To   66 :  For  i6  =   65   To   66 :  For  n  =   32   To   126  
103 With  ActiveWorkbook 
104 .Unprotect  Chr (i)  &   Chr (j)  &   Chr (k)  &  _ 
105 Chr (l)  &   Chr (m)  &   Chr (i1)  &   Chr (i2)  &  _ 
106 Chr (i3)  &   Chr (i4)  &   Chr (i5)  &   Chr (i6)  &   Chr (n) 
107 If  .ProtectStructure  =   False   And  _ 
108 .ProtectWindows  =   False   Then  
109 PWord1  =   Chr (i)  &   Chr (j)  &   Chr (k)  &   Chr (l)  &  _ 
110 Chr (m)  &   Chr (i1)  &   Chr (i2)  &   Chr (i3)  &  _ 
111 Chr (i4)  &   Chr (i5)  &   Chr (i6)  &   Chr (n) 
112 MsgBox  Application.Substitute(MSGPWORDFOUND1, _ 
113 " $$ " , PWord1), vbInformation, HEADER 
114 Exit   Do   ' Bypass all fornexts 
115 End   If  
116 End   With  
117 Next :  Next :  Next :  Next :  Next :  Next  
118 Next :  Next :  Next :  Next :  Next :  Next  
119 Loop  Until  True  
120 On   Error   GoTo   0  
121 End   If  
122 If  WinTag  And   Not  ShTag  Then  
123 MsgBox  MSGONLYONE, vbInformation, HEADER 
124 Exit   Sub  
125 End   If  
126 On   Error   Resume   Next  
127 For   Each  w1 In Worksheets 
128 ' Attempt clearance with PWord1 
129 w1.Unprotect PWord1 
130 Next  w1 
131 On   Error   GoTo   0  
132 ShTag  =   False  
133 For   Each  w1 In Worksheets 
134 ' Checks for all clear ShTag triggered to 1 if not. 
135 ShTag  =  ShTag  Or  w1.ProtectContents 
136 Next  w1 
137 If  ShTag  Then  
138 For   Each  w1 In Worksheets 
139 With  w1 
140 If  .ProtectContents  Then  
141 On   Error   Resume   Next  
142 Do   ' Dummy do loop 
143 For  i  =   65   To   66 :  For  j  =   65   To   66 :  For  k  =   65   To   66  
144 For  l  =   65   To   66 :  For  m  =   65   To   66 :  For  i1  =   65   To   66  
145 For  i2  =   65   To   66 :  For  i3  =   65   To   66 :  For  i4  =   65   To   66  
146 For  i5  =   65   To   66 :  For  i6  =   65   To   66 :  For  n  =   32   To   126  
147 .Unprotect  Chr (i)  &   Chr (j)  &   Chr (k)  &  _ 
148 Chr (l)  &   Chr (m)  &   Chr (i1)  &   Chr (i2)  &   Chr (i3)  &  _ 
149 Chr (i4)  &   Chr (i5)  &   Chr (i6)  &   Chr (n) 
150 If   Not  .ProtectContents  Then  
151 PWord1  =   Chr (i)  &   Chr (j)  &   Chr (k)  &   Chr (l)  &  _ 
152 Chr (m)  &   Chr (i1)  &   Chr (i2)  &   Chr (i3)  &  _ 
153 Chr (i4)  &   Chr (i5)  &   Chr (i6)  &   Chr (n) 
154 MsgBox  Application.Substitute(MSGPWORDFOUND2, _ 
155 " $$ " , PWord1), vbInformation, HEADER 
156 ' leverage finding Pword by trying on other sheets 
157 For   Each  w2 In Worksheets 
158 w2.Unprotect PWord1 
159 Next  w2 
160 Exit   Do   ' Bypass all fornexts 
161 End   If  
162 Next :  Next :  Next :  Next :  Next :  Next  
163 Next :  Next :  Next :  Next :  Next :  Next  
164 Loop  Until  True  
165 On   Error   GoTo   0  
166 End   If  
167 End   With  
168 Next  w1 
169 End   If  
170 MsgBox  ALLCLEAR  &  AUTHORS  &  VERSION  &  REPBACK, vbInformation, HEADER 
171 End Sub