1

We receive Excel workbook files every day which are password protected with the same password. We know this password. Is there a utility or method to remove password protection on these workbook files without invoking Excel.exe or the Excel object. Our goal is to take Excel out of the process and utilize SpreadsheetGear in VB.net. However, SpreadsheetGear can only unprotect worksheets not workbooks.

Thanks

4 Answers 4

3

You just need to set the Password property of the workbook to an empty string. In 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()
4
  • Greg, Thanks for the response. Unfortunately this misses the mark since it will still launch Excel.exe. I need some way to work with the file that doesn't involve the Excel object or exe.
    – SVTCobra
    Aug 11, 2009 at 20:26
  • Um, if you don't want to run Excel on a server, you may still want to reconsider. The Excel API has a few options for instantiation. One is to always use a new instance; this keeps multiple processes from stepping on each others' toes. Memory usage is maybe 20MB each - for the whole 1 second that it will be running.
    – Greg
    Aug 11, 2009 at 20:27
  • I agree, but we're already running Excel on the server and my boss would like to get it out of the process.
    – SVTCobra
    Aug 11, 2009 at 20:49
  • 4
    Waitaminnit here... you receive encrypted Excel spreadsheets and yet youur goal is to process something other than Excel... Dude, your solution is to tell your client to send you something other than Excel! Really, Excel is a great solution for some problems, but it sounds like you should be demanding something else like CSV...
    – Greg
    Aug 12, 2009 at 2:53
3

Following Babasharoo's great method, I did some optimizing and cleaning up, so we can now use it as a sub inside a module.

How to use:

  • Create a new excel workbook

  • Open VBA window in developer options menu

  • Create a new module and paste this code, then run the sub.

  • When the file dialog shows, select the password protected file.

    Code:

    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
    
1

Are they XLS or XLSX files?

for XLSX apparently you can use the RMS SDK to work with encrypted XLSX storage format. http://msdn.microsoft.com/en-us/library/aa767782(VS.85).aspx

Looking at it though its just a spec with almost no code samples so best of luck with that. once you have access to the underlying xml you can use standard xml namespace from .net or java to work with the file.

2003 (XLS) format, unless you use a propietrary 3rd party vendor solution that supports programmatic access (not aware of any specific products) you are out of luck.

1

you can add the following code to user form and drawing command button on the form this code will open all sheets and remove the password and open the file unprotected

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
1
  • Worked for me on Office 2019 .xlsx file. The userform + button part is an unnecessary implementation though. You could put this in a sub inside a module instead of a userform, it would be easier :) Anyway, thanks
    – cyberponk
    Jun 30, 2020 at 23:22

Not the answer you're looking for? Browse other questions tagged or ask your own question.