检查工作表密码是否受保护而不打开工作簿

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 Spreadsheet"("XMLSS")的基于XML的格式.

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

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

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

    

11. 右键单击工作表并在记事本/记事本++中打开它

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文件.