Password Cracker for Excel Worksheets/ Workbooks
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
|