在不打开工作簿的情况下检查工作表密码是否受到保护

Question

我一直在使用工作簿检查工作表是否存在或单元格中的内容，而无需使用此命令打开工作簿

f = "'" & strFilePath1 & "[" & strFileType & "]" & strSheetName & "'!" & Range(strCell).Address(True, True, -4150)

CheckCell = Application.ExecuteExcel4Macro(f)

它一直运行良好，但现在我想检查工作表是否受密码保护而无需打开但未成功。有人知道这是否可能吗？

提前感谢您的帮助

Answer 1

是的！这是可能的。我很久以前就发现了如何做到这一点。我怀疑这在网络上的任何地方都提到过......

基本介绍：如您所知，Microsoft Excel 直到 2007 版本都使用称为 Excel 二进制文件格式 (.XLS) 的专有二进制文件格式作为其主要格式。 Excel 2007 及更高版本使用 Office Open XML 作为其主要文件格式，这是一种基于 XML 的格式，紧随在 Excel 2002 中首次引入的名为“XML 电子表格”（“XMLSS”）的先前基于 XML 的格式之后.

逻辑：要了解其工作原理，请执行以下操作

1. 创建一个新的 Excel 文件
2. 确保它至少有 3 张纸
3. 使用blank 密码保护第一张纸
4. 不要保护第二张纸
5. 使用any密码保护第三张纸
6. 将文件保存为Book1.xlsx 并关闭文件
7. 将文件重命名为 Book1.Zip
8. 解压 zip 的内容
9. 转到文件夹\xl\worksheets

10. 您将看到工作簿中的所有工作表都已保存为Sheet1.xml、Sheet2.xml 和Sheet3.xml

11. 在工作表上右击，在notepad/notepad++中打开

12. 您会注意到您保护的所有工作表都有一个单词<sheetProtection，如下所示

因此，如果我们能够以某种方式检查相关工作表是否包含该单词，那么我们就可以确定工作表是否受到保护。

代码：

这里有一个功能可以帮助您实现您想要实现的目标

'~~> API to get the user temp path
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Sub Sample()
    '~~> Change as applicable
    MsgBox IsSheetProtected("Sheet2", "C:\Users\routs\Desktop\Book1.xlsx")
End Sub

Private Function IsSheetProtected(sheetToCheck As Variant, FileTocheck As Variant) As Boolean
    '~~> Temp Zip file name
    Dim tmpFile As Variant
    tmpFile = TempPath & "DeleteMeLater.zip"

    '~~> Copy the excel file to temp directory and rename it to .zip
    FileCopy FileTocheck, tmpFile

    '~~> Create a temp directory
    Dim tmpFolder As Variant
    tmpFolder = TempPath & "DeleteMeLater"

    '~~> Folder inside temp directory which needs to be checked
    Dim SheetsFolder As String
    SheetsFolder = tmpFolder & "\xl\worksheets\"

    '~~> Create the temp folder
    Dim FSO As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(tmpFolder) = False Then
        MkDir tmpFolder
    End If

    '~~> Extract zip file in that temp folder
    Dim oApp As Object
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(tmpFolder).CopyHere oApp.Namespace(tmpFile).items

    '~~> Loop through that folder to work with the relevant sheet (file)
    Dim StrFile As String
    StrFile = Dir(SheetsFolder & sheetToCheck & ".xml")

    Dim MyData As String, strData() As String
    Dim i As Long

    Do While Len(StrFile) > 0
        '~~> Read the xml file in 1 go
        Open SheetsFolder & StrFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1

        strData() = Split(MyData, vbCrLf)

        For i = LBound(strData) To UBound(strData)
            '~~> Check if the file has the text "<sheetProtection"
            If InStr(1, strData(i), "<sheetProtection", vbTextCompare) Then
                IsSheetProtected = True
                Exit For
            End If
        Next i

        StrFile = Dir
    Loop

    '~~> Delete temp file
    On Error Resume Next
    Kill tmpFile
    On Error GoTo 0

    '~~> Delete temp folder.
    FSO.deletefolder tmpFolder
End Function

'~~> Get User temp directory
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

注意：这已经针对.xlsx 和.xlsm 文件进行了测试。