Check folder to check if Excel files is protected

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Check folder to check if Excel files is protected

Post by gailb »

I have an Excel file with Excel file names in column A. I would like to run down column A and place in column B is that file is password protected.

Is this possible with VBA?

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Check folder to check if Excel files is protected

Post by HansV »

Does column A contain only file names, or the complete path + filename of the workbooks?
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Check folder to check if Excel files is protected

Post by gailb »

workbook name plus extension, but not the path. I would like to use the path of the active workbook.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Check folder to check if Excel files is protected

Post by HansV »

The following macro is inspired by VBA - Check if a workbook is protected before open it on StackOverflow. It should work for .xlsx, .xlsm and .xlsb workbooks, but not for .xls workbooks.

Code: Select all

Sub ListProtected()
    Dim strPath As String
    Dim sh As Object
    Dim r As Long
    Dim m As Long
    Dim strWbk As String
    Dim strZip As String
    Dim p As Long
    Dim nsp As Object
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Set sh = CreateObject("Shell.Application")
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        strWbk = Range("A" & r).Value
        p = InStrRev(strWbk, ".")
        strZip = Left(strWbk, p) & "zip"
        Name strPath & strWbk As strPath & strZip
        Set nsp = sh.Namespace(strPath & strZip)
        If nsp.Items.Count = 0 Then
            Range("B" & r).Value = "Protected"
        End If
        Name strPath & strZip As strPath & strWbk
    Next r
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Check folder to check if Excel files is protected

Post by gailb »

It doesn't seem to be working very well. It's only identifying .xls files, but these file are not even protected.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Check folder to check if Excel files is protected

Post by HansV »

This should be more dependable, but much slower:

Code: Select all

Sub ListProtected()
    Dim strPath As String
    Dim r As Long
    Dim m As Long
    Dim strWbk As String
    Dim wbk As Workbook
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    On Error Resume Next
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        strWbk = Range("A" & r).Value
        Set wbk = Nothing
        Set wbk = Workbooks.Open(Filename:=strPath & strWbk, Password:="")
        If wbk Is Nothing Then
            Range("B" & r).Value = "Protected"
        Else
            wbk.Close SaveChanges:=False
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Check folder to check if Excel files is protected

Post by gailb »

Okay, maybe I'm confused here and simply confusing the issue. I suppose this code is checking to see if the workbook is protected, but I'm looking to see if any worksheet has a password. Most of the time the workbook will not be protected, but the worksheet or worksheets will.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Check folder to check if Excel files is protected

Post by HansV »

That was not what you asked in your first post, hence the macro does not do what you want!

Stay tuned.
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Check folder to check if Excel files is protected

Post by HansV »

Try this:

Code: Select all

Sub ListProtected()
    Dim wsh As Worksheet
    Dim strPath As String
    Dim r As Long
    Dim m As Long
    Dim strWbk As String
    Dim wbk As Workbook
    Dim sh As Object
    Application.ScreenUpdating = False
    Set wsh = ActiveSheet
    strPath = ThisWorkbook.Path
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    m = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
    For r = 2 To m
        strWbk = Range("A" & r).Value
        Set wbk = Nothing
        On Error Resume Next
        Set wbk = Workbooks.Open(Filename:=strPath & strWbk, Password:="")
        If wbk Is Nothing Then
            wsh.Range("B" & r).Value = "Workbook is protected"
        Else
            For Each sh In wbk.Sheets
                If sh.ProtectContents Then
                    wsh.Range("B" & r).Value = "Workbook has at least one protected sheet"
                    Exit For
                End If
            Next sh
            wbk.Close SaveChanges:=False
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Check folder to check if Excel files is protected

Post by gailb »

Sorry about the poor explanation. This seems to do the trick.