logo标签列表

保护Excel工作表-不可能吗？

excelvbasecuritypasswordsms-office
3
我正在尝试共享一个 Excel 工作簿，但只允许访问几个可见工作表。由于 Excel 的安全漏洞和工作表的密码保护，这比我最初预期的要困难得多。
我的问题是由于一些需要保持隐藏且内容不可访问的隐藏工作表，在计算需要显示在可见工作表中的结果时却是必需的。
到目前为止，我已经尝试在 VBA 窗口中“超级隐藏”工作表并锁定 VBA 项目。想法是用户无法在没有 VBA 项目密码的情况下取消隐藏“超级隐藏”的工作表。 我已经尝试添加额外的 VBA 代码来对抗某些“攻击”，但我始终回到一个已知的漏洞，可以规避我所有的努力：
步骤1： 保存或确保 Excel 工作簿保存为 .xlsx 或 .xlsm。
步骤2： 从不同的工作簿或您的 personal.xlsb 运行以下代码，以删除工作表和结构保护的密码 （我本来会链接到我找到代码的帖子，但现在找不到了...）。
Sub RemoveProtection()

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

'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
    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 _
& "_" & Format(Now, "dd-mmm-yy h-mm-ss") & "." & sourceFileType

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

End Sub

第三步： 运行以下代码以取消隐藏所有工作表。
Sub UnhideAllSheets()

For Each Worksheet In ActiveWorkbook.Sheets
        Worksheet.Visible = -1
Next Worksheet

End Sub

现在，通过将工作簿保存为.xlsx文件，工作表和结构保护上的所有密码以及任何“计数器” VBA 代码都已经被清除。

我考虑添加一个用户定义的函数来检查工作簿文件的扩展名是否为“.xlsb”。如果扩展名是“.xlsb”，该函数将返回“1”，然后将其乘以重要内容。如果工作簿被保存为其他格式，或者VBA项目完全被删除，保存为.xlsx，则会导致计算失败。 但是，我不喜欢这种方法，因为我认为它不是长期的解决方案...

因此，我的问题是： 有没有一种安全地共享Excel工作簿的方法，只能访问几个工作表，而不会冒险让用户访问隐藏的工作表和/或不需要的内容？

据我所知，没有完全安全的方法来保护Excel工作簿/工作表。其中一种方法是对数据进行编码，即使内容被取消隐藏，也无法利用它而不使用解码功能。 - Vincent G
你好 Vincent G，有趣的想法 - 你打算如何实现呢？像 Excel 中的 SHA256 函数吗？ - DAL
1
我认为这个问题的普遍结论是，你永远不能假设Excel是安全的。 - BigBen
这也是我目前得出的结论 - 不幸的是... - DAL
1个回答
0
在VBE中，您可以将特定工作表的Visible属性更改为xlSheetVeryHidden。

enter image description here

这将完全从前端中删除它。

然后，您可以在VBE中为VBA项目添加密码，以防止用户更改该属性（即使他们知道它）。

enter image description here

此外，您仍然可以使用VBA代码访问这些工作表。
编辑：
我还要添加的是对特定工作表的密码保护，这是正常的。但也有一个自定义的UserForm，如果他们必须取消隐藏它，则会触发UserForm的Worksheet_Activate事件。如果他们输入了错误的密码或关闭了UserForm，则该工作表将再次被隐藏。您可以向此事件处理程序添加各种内容，例如重新保护工作表、重新保护项目、使用加密密码保护工作簿并将其关闭为安全漏洞。
可能性是无限的。虽然不是完全的预防措施，但希望这可以帮助到您。
我认为问题的第三段已经解释了他已经这样做了。 - Vincent G
@VincentG 我已经添加了更多内容。感谢您的指出。 - Dean
你好Dean，我也尝试过这个方法，但是在保存文件为.xlsx格式时失败了（这会删除带有计数器代码的VBA项目）。如果你将工作簿保存为.xlsx文件并运行第2步和第3步，你的工作表将可见且未受密码保护，而你的VBA将消失... - DAL
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接