Check if worksheet password protected without opening workbook

Question

I have been doing checks with worksbooks for things like if the sheet exists or what is in a cell without opening the workbook using this command

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

CheckCell = Application.ExecuteExcel4Macro(f)

and it has been working well but now i am wanting to check if the sheet is Password protected without opening but haven't been successful. Anyone know if this is possible?

Thanks for help in advance

Answer 1

Yes! It is possible. I discovered how to do it long time ago. I doubt this is mentioned anywhere in the web...

Basic Introduction: As you are aware, Microsoft Excel up until 2007 version used a proprietary binary file format called Excel Binary File Format (.XLS) as its primary format. Excel 2007 onwards uses Office Open XML as its primary file format, an XML-based format that followed after a previous XML-based format called "XML Spreadsheet" ("XMLSS"), first introduced in Excel 2002.

Logic: To understand how this works, do the following

1. Create a new Excel file
2. Ensure it has at least 3 sheets
3. Protect the 1st sheet with a blank password
4. Leave the 2nd sheet unprotected
5. Protect the 3rd sheet using any password
6. Save the file, say, as Book1.xlsx and close the file
7. Rename the file to, say, Book1.Zip
8. Extract the contents of the zip
9. Go to the folder \xl\worksheets

10. You will see that all the sheets from the workbook has been saved as Sheet1.xml,Sheet2.xml and Sheet3.xml

    

11. Right click on the sheets and open it in notepad/notepad++

12. You will notice that all the sheets you protected has one word <sheetProtection as shown below

    

So if we can somehow check if the relevant sheet has that word then we can ascertain whether the sheet is protected or not.

Code:

Here is a function which can help you in what you want to achieve

'~~> 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

Note: This has been tested for .xlsx and .xlsm files.