Sunday, 30 December 2012
Unprotecting a protected Workbook
I don't advocate it, but this is a script to break the password on a password protected Excel workbook
Sub UnprotectWorkBook()
'Break the Password on a Protected Excel Workbook
Dim funnet As Boolean: Dim tekst As String
Dim i As Integer: Dim j As Integer: Dim k As Integer: Dim l As Integer
Dim m As Integer: Dim N As Integer: Dim o As Integer: Dim p As Integer
Dim gmlStatusLinje As Variant: Dim gmlTid As Variant
Dim oldCalculation As Integer
On Error Resume Next
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
oldCalculation = Application.Calculation
Application.Calculation = xlManual
Application.ScreenUpdating = False
gmlStatusLinje = Application.DisplayStatusBar
Application.DisplayStatusBar = True
gmlTid = Now()
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
ActiveWorkbook.Unprotect
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If Not funnet Then
For i = lower To upper
tekst = Chr(i)
ActiveWorkbook.Unprotect '(tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If Not funnet Then
For i = lower1 To lower2
For j = lower To upper
tekst = Chr(i) + Chr(j)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
End If
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2
For k = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2
For l = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2
For N = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(N)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2: For N = lower1 To lower2
For o = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(N) + Chr(o)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower1 To lower2: For N = lower1 To lower2: For o = lower1 To lower2
For p = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(N) + Chr(o) + Chr(p)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
Application.ScreenUpdating = True
Call MsgBox(tekstBook & " Time: " & Format(Now() - gmlTid, "hh.mm.ss") & Chr(13) & Chr(13) & "The Protection on the Workbook should now be broken." & Chr(13) & "Check Tools > Protection > Protect Workbook" & Chr(13) & "to ensure the protection has been removed." & Chr(13) & Chr(13), vbOKOnly + vbInformation, progName)
Application.StatusBar = False
Application.DisplayStatusBar = gmlStatusLinje
Application.Calculation = oldCalculation
End Sub
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment