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

Question

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

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

CheckCell = Application.ExecuteExcel4Macro(f)

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

感谢您提前提供帮助

Answer 1

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

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

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

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

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

    

11. 右键单击工作表并在记事本/ 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文件。