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

No comments:

Post a Comment