Protection‎ > ‎

All Files in Folder

Protect / Unprotect all files in a folder

This code will:
  1. Prompt you to select a folder
  2. Prompt you to select PROTECT or UNPROTECT action on the files in that folder
  3. Prompt you to select to affect the WORKSHEETS or WORKBOOK STRUCTURE
  4. Prompt you to enter a password to use
  5. Process all the files in that folder with options above
  6. Give a count afterward of how many files were affected

CODE:

Option Explicit

Sub SetProtectionInAllSheetsAllFilesInFolder()
'Jerry Beaucaire - 3/4/2010
'Select a folder and provide password to protect all Excel files in folder
'7/11/2014 - affect worksheets or workbook structure
Dim fPath As String, fName As String
Dim pwd As String, pwd2 As String, ws As Worksheet, wb As Workbook
Dim Ans As Long, Ans2 As Long, Cnt As Long

'Folder selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
    End With
   
'Choose whether to protect or unprotect the files
    Ans = Application.InputBox("Are we protecting or unprotecting the files in this folder?" & vbLf & vbLf & _
        "Enter 1 - protect files" & vbLf & "Enter 2 - unprotect files" & vbLf & vbLf & _
        "Any other value or CANCEL will abort", "Protect or Unprotect?", Type:=1)
    If Ans < 1 Or Ans > 2 Then Exit Sub
   
'Choose whether to protect or unprotect the sheets or the workbook structure
    Ans2 = Application.InputBox("Are we protecting/unprotecting the worksheets in each file or the structure?" & vbLf & vbLf & _
        "Enter 1 - affect worksheets" & vbLf & "Enter 2 - affect structure" & vbLf & "Enter 3 - affect both worksheets and structure" & vbLf & vbLf & _
        "Any other value or CANCEL will abort", "Worksheets or Structure?", Type:=1)
    If Ans2 < 1 Or Ans2 > 3 Then Exit Sub
   
'Password w/verification
    Do
        pwd = Application.InputBox("What password to use?", "Enter Password", Type:=2)
        If pwd = "False" Then Exit Sub
        pwd2 = Application.InputBox("Please enter the password again for verification?", "Re-Enter Password", Type:=2)
        If pwd2 = "False" Then Exit Sub
        If pwd = pwd2 Then Exit Do Else MsgBox "Passwords did not match, please try again"
    Loop

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    fName = Dir(fPath & "*.xls*")               'get first Excel filename

'File protection
    Do While Len(fName) > 0
        Set wb = Workbooks.Open(fPath & fName)  'open the found file
        If Ans2 = 1 Or Ans2 = 3 Then                         'process the sheets...
            For Each ws In wb.Worksheets
                If Ans = 1 Then ws.Protect Password:=pwd Else ws.Unprotect Password:=pwd
            Next ws
        End If
        If Ans2 = 2 Or Ans2 = 3 Then
            If Ans = 1 Then
                wb.Protect Password:=pwd, Structure:=True, Windows:=False
            Else
                wb.Unprotect Password:=pwd
            End If
        End If
        wb.Save
        wb.Close                                'save and close the file
        Cnt = Cnt + 1                           'update counter
        fName = Dir                             'get next filename
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    MsgBox "A total of " & Cnt & " files were processed"
End Sub























Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!
Comments