Can I check if all excels in a folder have been given password protection?

[jscranton]

First, I am not trying to crack any passwords. I am, instead, trying to make sure that a large folder of excels all have been password protected. Obviously, the issue with something like the below is that I have to open the password protected wb to set the variable (which I can't do with a password protected book).

Any thoughts?

Sub IsWorkbookProtected()Dim wb As Workbook
Dim myPath
Dim myFile

  myPath = "SomePath\"


  Do While myFile <> ""

      Set wb = Workbooks.Open(Filename:=myPath & myFile)


     With wb
       If .ProtectWindows Or .ProtectStructure Then
         Debug.Print .PasswordEncryptionAlgorithm
      Else
        Debug.Print "This workbook is not password protected"
      End If
     End With

      myFile = Dir

Loop


End Sub

 

[dmt32]

Hi,
try following & see if does what you want

Sub IsWorkbookProtected()
    Dim wb As Workbook
    Dim myPath As String, myFile As String
    Dim listFiles As Range
    Dim r As Long
    
    myPath = "C:\SomePath\"
    
'range to list all unprotected files
    Set listFiles = ThisWorkbook.Sheets(1).Range("A1")
    
    myFile = Dir(myPath & "*.xl*", vbDirectory)
    
    Application.ScreenUpdating = False
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            On Error Resume Next
'open workbook with junk password
            Set wb = Workbooks.Open(FileName:=myPath & myFile, Password:="abczzzzzzz")
            If Err.Number = 0 Then
'file not protected - add to list
                listFiles.Offset(r, 0).Value = myFile
                r = r + 1
            End If
            wb.Close False
        End If
        On Error GoTo 0
        myFile = Dir
        Set wb = Nothing
    Loop
    Application.ScreenUpdating = True
End Sub

Dave