View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
[email protected] kthprog@gmail.com is offline
external usenet poster
 
Posts: 7
Default Password Cracker for Excel Worksheets/ Workbooks

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