Снятие пароля Эксель

Это файлы XLS или XLSX?

для XLSX, по-видимому, вы можете использовать RMS SDK для работы с зашифрованным форматом хранения XLSX. http://msdn.microsoft.com/en-us/library/aa767782(VS.85).aspx

Глядя на это, хотя это просто спецификация почти без образцов кода, так что удачи с этим. когда у вас есть доступ к базовому xml, вы можете использовать стандартное пространство имен xml из .net или java для работы с файлом.

2003 (XLS), если вы не используете проприетарное решение стороннего поставщика, которое поддерживает программный доступ (не зная о каких-либо конкретных продуктах), вам не повезло.

Вам просто нужно установить для свойства Password рабочей книги пустую строку. В Питоне:

from win32com.client import DispatchEx
xlApp = DispatchEx("Excel.Application")
xlApp.Workbooks.Open (mySpreadsheet, Password=myPassword, WriteResPassword=myPassword)
xlWB = xlApp.Workbooks[0]
xlWB.Password = ""
xlWB.Save()
xlWB.Close(False)
xlApp.Quit()

Следуя замечательному методу Бабашару, я провел некоторую оптимизацию и очистку, так что теперь мы можем использовать его в качестве подпрограммы внутри модуля.

Как пользоваться:

• Создать новую книгу Excel

• Откройте окно VBA в меню параметров разработчика

• Создайте новый модуль и вставьте этот код, затем запустите sub.

• Когда появится диалоговое окно файла, выберите файл, защищенный паролем.

  Код:

  Private Sub RemovePasswordFromWorkbook()
    Dim dialogBox As FileDialog
    Dim sourceFullName As String
    Dim sourceFilePath As String
    Dim sourceFileName As String
    Dim sourceFileType As String
    Dim newFileName As Variant
    Dim tempFileName As String
    Dim zipFileName As Variant
    Dim oApp As Object
    Dim xmlSheetFile As String
    Dim xmlFile As Integer
    Dim xmlFileContent As String
    Dim xmlStartProtectionCode As Double
    Dim xmlEndProtectionCode As Double
    Dim xmlProtectionString As String
    Dim ws As Worksheet, wb As Workbook
    Dim fso As Object
  
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    'Open dialog box to select a file
    Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select file to remove protection from..."
  
    If dialogBox.Show <> -1 Then Exit Sub
    sourceFullName = dialogBox.SelectedItems(1)
  
    'Get folder path, file type and file name from the sourceFullName
    sourceFilePath = fso.GetParentFolderName(sourceFullName)
    sourceFileType = fso.GetExtensionName(sourceFullName)
    sourceFileName = fso.GetBaseName(sourceFullName)
    If LCase(sourceFileType) = "xls" Or LCase(sourceFileType) = "xlt" Or LCase(sourceFileType) = "xla" Then
        MsgBox "This code does not work on old Excel files (97-2003). Please convert file to a new Excel file and try again"
        Exit Sub
    End If
  
    'Use the date and time to create a unique file name
    tempFileName = fso.BuildPath(Environ("TEMP"), fso.GetTempName())
  
    'Create temporary file with a unique name
    newFileName = tempFileName & ".zip"
    On Error Resume Next
    FileCopy sourceFullName, newFileName
  
    If Err.Number <> 0 Then
        MsgBox "Unable to copy " & sourceFullName & vbNewLine _
            & "Check the file is closed and try again" & vbNewLine & vbNewLine & _
            Err.Description
        Exit Sub
    End If
    On Error GoTo 0
  
    'Create folder to unzip to
    MkDir tempFileName & "\"
  
    'Extract the files into the newly created folder
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(tempFileName & "\").CopyHere oApp.Namespace(newFileName).Items
  
    'loop through each file in the \xl\worksheets folder of the unzipped file
    xmlSheetFile = Dir(tempFileName & "\xl\worksheets\*.xml*")
    Do While xmlSheetFile <> ""
  
        'Read text of the file to a variable
        xmlFile = FreeFile
        Open tempFileName & "\xl\worksheets\" & xmlSheetFile For Input As xmlFile
        xmlFileContent = Input(LOF(xmlFile), xmlFile)
        Close xmlFile
  
        'Manipulate the text in the file
        xmlStartProtectionCode = 0
        xmlStartProtectionCode = InStr(1, xmlFileContent, "<sheetProtection")
  
        If xmlStartProtectionCode > 0 Then
            xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
                xmlFileContent, "/>") + 2 '"/>" is 2 characters long
            xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
                xmlEndProtectionCode - xmlStartProtectionCode)
            xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
        End If
  
        'Output the text of the variable to the file
        xmlFile = FreeFile
        Open tempFileName & "\xl\worksheets\" & xmlSheetFile For Output As xmlFile
        Print #xmlFile, xmlFileContent
        Close xmlFile
  
        'Loop to next xmlFile in directory
        xmlSheetFile = Dir
    Loop
  
    'Read text of the xl\workbook.xml file to a variable
    xmlFile = FreeFile
    Open tempFileName & "\xl\workbook.xml" For Input As xmlFile
    xmlFileContent = Input(LOF(xmlFile), xmlFile)
    Close xmlFile
  
    'Manipulate the text in the file to remove the workbook protection
    xmlStartProtectionCode = 0
    xmlStartProtectionCode = InStr(1, xmlFileContent, "<workbookProtection")
    If xmlStartProtectionCode > 0 Then
  
        xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
            xmlFileContent, "/>") + 2 ''"/>" is 2 characters long
        xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
            xmlEndProtectionCode - xmlStartProtectionCode)
        xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
  
    End If
  
    'Manipulate the text in the file to remove the modify password
    xmlStartProtectionCode = 0
    xmlStartProtectionCode = InStr(1, xmlFileContent, "<fileSharing")
    If xmlStartProtectionCode > 0 Then
  
        xmlEndProtectionCode = InStr(xmlStartProtectionCode, xmlFileContent, _
            "/>") + 2 ''"/>" is 2 characters long
        xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
            xmlEndProtectionCode - xmlStartProtectionCode)
        xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")
  
    End If
  
    'Output the text of the variable to the file
    xmlFile = FreeFile
    Open tempFileName & "\xl\workbook.xml" & xmlSheetFile For Output As xmlFile
    Print #xmlFile, xmlFileContent
    Close xmlFile
  
    'Create empty Zip File
    zipFileName = sourceFullName & ".zip"
    Open zipFileName For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
  
    'Move files into the zip file
    oApp.Namespace(zipFileName).CopyHere _
    oApp.Namespace(tempFileName & "\").Items
    'Keep script waiting until Compressing is done
    On Error Resume Next
    Do Until oApp.Namespace(zipFileName).Items.Count = _
        oApp.Namespace(tempFileName & "\").Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
  
    'Delete the files & folders created during the sub
    fso.DeleteFolder tempFileName
    fso.DeleteFolder tempFileName & ".zip"
  
    'Rename the final file back to an xlsx file
    newFileName = fso.BuildPath(sourceFilePath, sourceFileName & " (cracked)" & "." & sourceFileType)
    Name zipFileName As newFileName
  
    'Show message box
    Set wb = Workbooks.Open(Filename:=newFileName)
    If MsgBox("The workbook and worksheet protection passwords have been removed  :)." & vbNewLine & _
       "Unhide all cells and worksheets?", vbInformation + vbYesNo, Title:="By :Mr.shaaban feat. cyberponk") = vbYes Then
        For Each ws In wb.Worksheets
            Columns.EntireColumn.Hidden = False
            Rows.EntireRow.Hidden = False
            ws.Visible = xlSheetVisible
        Next ws
    End If
  
    MsgBox "It Is yours now.......By Mr.Sha3ban feat. cyberponk", _
    vbInformation + vbOKOnly, Title:="By :Mr.shaaban feat. cyberponk"
  End Sub
  

вы можете добавить следующий код в форму пользователя и кнопку команды рисования в форме, этот код откроет все листы, удалит пароль и откроет файл незащищенным

Private Sub CommandButton1_Click()
Dim dialogBox As FileDialog
Dim sourceFullName As String
Dim sourceFilePath As String
Dim sourceFileName As String
Dim sourceFileType As String
Dim newFileName As Variant
Dim tempFileName As String
Dim zipFilePath As Variant
Dim oApp As Object
Dim FSO As Object
Dim xmlSheetFile As String
Dim xmlFile As Integer
Dim xmlFileContent As String
Dim xmlStartProtectionCode As Double
Dim xmlEndProtectionCode As Double
Dim xmlProtectionString As String
Dim ws as Worksheet


'Open dialog box to select a file
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
dialogBox.AllowMultiSelect = False
dialogBox.Title = "Select file to remove protection from......Shaaban"

If dialogBox.Show = -1 Then
    sourceFullName = dialogBox.SelectedItems(1)
Else
    Exit Sub
End If

'Get folder path, file type and file name from the sourceFullName
sourceFilePath = Left(sourceFullName, InStrRev(sourceFullName, "\"))
sourceFileType = Mid(sourceFullName, InStrRev(sourceFullName, ".") + 1)
sourceFileName = Mid(sourceFullName, Len(sourceFilePath) + 1)
sourceFileName = Left(sourceFileName, InStrRev(sourceFileName, ".") - 1)

'Use the date and time to create a unique file name
tempFileName = "Temp" & Format(Now, " dd-mmm-yy h-mm-ss")

'Copy and rename original file to a zip file with a unique name
newFileName = sourceFilePath & tempFileName & ".zip"
On Error Resume Next
FileCopy sourceFullName, newFileName

If Err.Number <> 0 Then
    MsgBox "Unable to copy " & sourceFullName & vbNewLine _
        & "Check the file is closed and try again"
    Exit Sub
End If
On Error GoTo 0

'Create folder to unzip to
zipFilePath = sourceFilePath & tempFileName & "\"
MkDir zipFilePath

'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(zipFilePath).CopyHere oApp.Namespace(newFileName).items

'loop through each file in the \xl\worksheets folder of the unzipped file
xmlSheetFile = Dir(zipFilePath & "\xl\worksheets\*.xml*")
Do While xmlSheetFile <> ""

    'Read text of the file to a variable
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Input As xmlFile
    xmlFileContent = Input(LOF(xmlFile), xmlFile)
    Close xmlFile

    'Manipulate the text in the file
    xmlStartProtectionCode = 0
    xmlStartProtectionCode = InStr(1, xmlFileContent, "<sheetProtection")

    If xmlStartProtectionCode > 0 Then

        xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
            xmlFileContent, "/>") + 2 '"/>" is 2 characters long
        xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
            xmlEndProtectionCode - xmlStartProtectionCode)
        xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

    End If

    'Output the text of the variable to the file
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Output As xmlFile
    Print #xmlFile, xmlFileContent
    Close xmlFile

    'Loop to next xmlFile in directory
    xmlSheetFile = Dir

Loop

'Read text of the xl\workbook.xml file to a variable
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" For Input As xmlFile
xmlFileContent = Input(LOF(xmlFile), xmlFile)
Close xmlFile

'Manipulate the text in the file to remove the workbook protection
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<workbookProtection")
If xmlStartProtectionCode > 0 Then

    xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
        xmlFileContent, "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

End If

'Manipulate the text in the file to remove the modify password
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<fileSharing")
If xmlStartProtectionCode > 0 Then

    xmlEndProtectionCode = InStr(xmlStartProtectionCode, xmlFileContent, _
        "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

End If

'Output the text of the variable to the file
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" & xmlSheetFile For Output As xmlFile
Print #xmlFile, xmlFileContent
Close xmlFile

'Create empty Zip File
Open sourceFilePath & tempFileName & ".zip" For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'Move files into the zip file
oApp.Namespace(sourceFilePath & tempFileName & ".zip").CopyHere _
oApp.Namespace(zipFilePath).items
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(sourceFilePath & tempFileName & ".zip").items.Count = _
    oApp.Namespace(zipFilePath).items.Count
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

'Delete the files & folders created during the sub
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder sourceFilePath & tempFileName

'Rename the final file back to an xlsx file
Name sourceFilePath & tempFileName & ".zip" As sourceFilePath & sourceFileName _
& " " & "With no password" & "." & sourceFileType

'Show message box
MsgBox "The workbook and worksheet protection passwords have been removed  :).", _
vbInformation + vbOKOnly, Title:="By :Mr.shaaban"

Workbooks.Open Filename:=(sourceFilePath & sourceFileName & " " & "With no password" & "." & sourceFileType)


For Each ws In ActiveWorkbook.Worksheets
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
ws.Visible = xlSheetVisible

Next ws
MsgBox "It Is yours now.......By Mr.Sha3ban", _
vbInformation + vbOKOnly, Title:="By :Mr.shaaban"
End Sub

Private Sub UserForm_Deactivate()
Application.ActiveWindow.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True


End Sub

Private Sub UserForm_Initialize()
Application.Visible = False
End Sub