excel - Excel密码删除

Question

我们每天都会收到使用相同密码保护的 Excel 工作簿文件。我们知道这个密码。是否有实用程序或方法可以在不调用 Excel.exe 或 Excel 对象的情况下删除这些工作簿文件的密码保护。我们的目标是让 Excel 脱离流程并在 VB.net 中使用 SpreadsheetGear。但是，SpreadsheetGear 只能取消保护工作表而不是工作簿。

谢谢

score 3 · Accepted Answer

您只需要将工作簿的 Password 属性设置为空字符串。在 Python 中：

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()

score 3 · Accepted Answer

按照 Babasharoo 的好方法，我做了一些优化和清理，所以我们现在可以将它用作模块中的子组件。

如何使用：

创建一个新的 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

score 1 · Accepted Answer

它们是 XLS 还是 XLSX 文件？

对于 XLSX，显然您可以使用 RMS SDK 来处理加密的 XLSX 存储格式。 http://msdn.microsoft.com/en-us/library/aa767782(VS.85).aspx

虽然它只是一个几乎没有代码示例的规范，但看看它，祝你好运。一旦您有权访问底层 xml，您就可以使用来自 .net 或 java 的标准 xml 命名空间来处理该文件。

2003 (XLS) 格式，除非您使用支持编程访问的专有第 3 方供应商解决方案（不知道任何特定产品），否则您将不走运。

score 1 · Accepted Answer

您可以将以下代码添加到用户表单和表单上的绘图命令按钮此代码将打开所有工作表并删除密码并打开未受保护的文件

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

excel - Excel密码删除

4 回答 4

Related

Reference