Проверьте, защищен ли рабочий лист паролем, не открывая книгу

Question

Я проверял рабочие книги на наличие таких вещей, как, если лист существует или находится в ячейке, не открывая книгу с помощью этой команды

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

CheckCell = Application.ExecuteExcel4Macro(f)

, и она работала хорошо, но теперь я хочупроверить, защищен ли лист паролем, не открывая, но не удалось.Кто-нибудь знает, возможно ли это?

Заранее спасибо за помощь

Answer 1

Да! Это возможно.Я обнаружил, как это сделать давным-давно.Я сомневаюсь, что это упоминается где-либо в Интернете ...

Базовое введение : Как вам известно, в Microsoft Excel до версии 2007 использовался собственный формат двоичных файлов, называемый Excel Binary File Format (.XLS) в качестве основного формата.Excel 2007 и выше использует Office Open XML в качестве основного формата файла, формата на основе XML, который последовал после предыдущего формата на основе XML, называемого «XML Spreadsheet» («XMLSS»), впервые представленного в Excel 2002.

Логика : Чтобы понять, как это работает, выполните следующие действия:

1. Создайте новый файл Excel
2. Убедитесь, что в нем не менее 3 листов
3. Защитите 1-й лист с помощью blank пароля
4. Оставьте 2-й лист незащищенным
5. Защитите 3-й лист с помощью any пароля
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.