Public LogModi As Boolean
Dim Start As Date

Sub MainExprt()
  FrmExprt.MainFrmExprt
End Sub

Sub Mappe(ArbMappe)
  On Error GoTo Ende
  If Workbooks(ArbMappe).ProtectStructure = False And Workbooks(ArbMappe).ProtectWindows = False Then
    If FrmExprt.CbxStatus.Value = True Then
      Status "Workbook not protected: """ & Workbooks(ArbMappe).Name & """"
    End If
    If FrmExprt.CbxLog.Value = True Then
      Log "Workbook not protected: """ & Workbooks(ArbMappe).Name & """"
    End If
    Exit Sub
  End If
  Workbooks(ArbMappe).Activate
  Application.StatusBar = "Trying to decrypt workbook """ & Workbooks(ArbMappe).Name & ""
  FrmExprt.Repaint
  If FrmExprt.CbxLog.Value = True Then
    Log "Trying to decrypt workbook """ & Workbooks(ArbMappe).Name & ""
  End If
  On Error Resume Next
  Start = Time
  With ActiveWorkbook
    .Protect Structure:=True, Windows:=True, password:="a"
    .Unprotect "a"
  End With
  If ActiveWorkbook.ProtectStructure = False Then
    Ende = Time
    If FrmExprt.CbxStatus.Value = True Then
      Status "Workbook """ & Workbooks(ArbMappe).Name & """ has been decrypted"
    End If
    If FrmExprt.CbxLog.Value = True Then
      Log "Workbook """ & Workbooks(ArbMappe).Name & """ has been decrypted"
      Log "Time needed: " & Zeit(Ende)
    End If
    Exit Sub
  End If
Ende:
End Sub

Sub Blatt(ArbMappe, ArbBlatt)
  Dim z1 As Byte, z2 As Byte, z3 As Byte, z4 As Byte, z5 As Byte, z6 As Byte, z7 As Byte, z8 As Byte, z9 As Byte, z10 As Byte
  
  On Error GoTo Ende
  If Workbooks(ArbMappe).Sheets(ArbBlatt).ProtectContents = False Then
    If FrmExprt.CbxStatus.Value = True Then
      Status "Worksheet not protected: """ & Workbooks(ArbMappe).Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
    End If
    If FrmExprt.CbxLog.Value = True Then
      Log "Worksheet not protected: """ & Workbooks(ArbMappe).Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
    End If
    Exit Sub
  End If
  Workbooks(ArbMappe).Sheets(ArbBlatt).Activate
  Application.StatusBar = "Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ") - " & Zeit(Time)
  FrmExprt.Repaint
  If FrmExprt.CbxLog.Value = True Then
    Log "Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
  End If
  On Error Resume Next
  Start = Time
  
  For z1 = 32 To 126
    ActiveSheet.Unprotect Chr(z1)
  Next z1
  If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
  Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
  
  For z1 = 1 To 2
    For z2 = 32 To 126
      ActiveSheet.Unprotect z1 & Chr(z2)
    Next z2
    If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
    Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
  Next z1
  
  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 32 To 126
        ActiveSheet.Unprotect z1 & z2 & Chr(z3)
      Next z3
      If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
      Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
    Next z2
  Next z1
  
  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 32 To 126
          ActiveSheet.Unprotect z1 & z2 & z3 & Chr(z4)
        Next z4
        If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
        Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
      Next z3
    Next z2
  Next z1

  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 32 To 126
            ActiveSheet.Unprotect z1 & z2 & z3 & z4 & Chr(z5)
          Next z5
          If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
          Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
        Next z4
      Next z3
    Next z2
  Next z1
  
  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 1 To 2
            For z6 = 32 To 126
              ActiveSheet.Unprotect z1 & z2 & z3 & z4 & z5 & Chr(z6)
            Next z6
            If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
            Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
          Next z5
        Next z4
      Next z3
    Next z2
  Next z1

  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 1 To 2
            For z6 = 1 To 2
              For z7 = 32 To 126
                ActiveSheet.Unprotect z1 & z2 & z3 & z4 & z5 & z6 & Chr(z7)
              Next z7
              If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
              Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
            Next z6
          Next z5
        Next z4
      Next z3
    Next z2
  Next z1

  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 1 To 2
            For z6 = 1 To 2
              For z7 = 1 To 2
                For z8 = 32 To 126
                  ActiveSheet.Unprotect z1 & z2 & z3 & z4 & z5 & z6 & z7 & Chr(z8)
                Next z8
                If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
                Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
              Next z7
            Next z6
          Next z5
        Next z4
      Next z3
    Next z2
  Next z1
  
  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 1 To 2
            For z6 = 1 To 2
              For z7 = 1 To 2
                For z8 = 1 To 2
                  For z9 = 32 To 126
                    ActiveSheet.Unprotect z1 & z2 & z3 & z4 & z5 & z6 & z7 & z8 & Chr(z9)
                  Next z9
                  If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
                  Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
                Next z8
              Next z7
            Next z6
          Next z5
        Next z4
      Next z3
    Next z2
  Next z1

  For z1 = 1 To 2
    For z2 = 1 To 2
      For z3 = 1 To 2
        For z4 = 1 To 2
          For z5 = 1 To 2
            For z6 = 1 To 2
              For z7 = 1 To 2
                For z8 = 1 To 2
                  For z9 = 1 To 2
                    For z10 = 32 To 126
                            ActiveSheet.Unprotect z1 & z2 & z3 & z4 & z5 & z6 & z7 & z8 & z9 & Chr(z10)
                    Next z10
                    If Test(ArbMappe, ArbBlatt) = True Then Exit Sub
                    Application.StatusBar = Zeit(Time) & " - Trying to decrypt worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")"
                  Next z9
                Next z8
              Next z7
            Next z6
          Next z5
        Next z4
      Next z3
    Next z2
  Next z1
Ende:
End Sub

Private Function Test(ArbMappe, ArbBlatt) As Boolean
  If ActiveSheet.ProtectContents = False Then
    Ende = Time
    If FrmExprt.CbxStatus.Value = True Then
      Status "Worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")" & " has been decrypted"
    End If
    If FrmExprt.CbxLog.Value = True Then
      Log "Worksheet """ & Sheets(ArbBlatt).Name & """ (" & Workbooks(ArbMappe).Name & ")" & " has been decrypted"
      Log "Time needed: " & Zeit(Ende)
    End If
    Test = True
  End If
End Function

Private Function Zeit(ByVal Ende As Date) As Date
  Zeit = Format(Ende - Start, "Long Time")
End Function

Function Status(Meldung$)
  If FrmExprt.TxtStatus.Text = "" Then
    FrmExprt.TxtStatus.Text = Meldung
  Else
    FrmExprt.TxtStatus.Text = FrmExprt.TxtStatus.Text & vbCrLf & Meldung
  End If
  FrmExprt.TxtStatus.SetFocus
End Function

Private Function Log(Meldung$)
  LogDat = FrmExprt.TxtLog.Text
  Open LogDat For Append As #1
    Print #1, Now & " - " & Meldung
  Close #1
  LogModi = True
End Function