• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Unprotect or Protect a particular Sheet

navic

Active Member
I want to Unprotect/Protect a specific worksheet in multiple closed (*.xls*) workbooks in the same folder.
I found a lot of VBA macros but didn't find what I wanted.

1. The VBA should allow the user to select a folder (which is variable) that contains over 100 workbooks.
2. Open the first workbook,
3. Remove protection from a specific worksheet (only one specific worksheet named 'Production').
4. Save the workbook (no password on the worksheet). Optionally VBA code if we have to set a password.
5. The next workbook

This is one of the VBA macros I have found and am trying to customize to my requirements.
Code:
Option Explicit
Const cStartFolder = "C:\Temp" 'no slash at end! - This should be changeable by user choice
Const cFileFilter = "*.xls*"
Const cPassword = "123" 'use empty quotes if blank

'Sub UnprotectCertainNamedSheet()
Sub UnprotectAllWorksheets()

    Dim i As Long, j As Long, arr() As String, wkb As Workbook, wks As Worksheet
    
    ExtractFolder cStartFolder, arr()

    On Error Resume Next
    j = -1: j = UBound(arr)
    On Error GoTo 0

    For i = 0 To j
        Set wkb = Workbooks.Open(arr(i), False)
        For Each wks In wkb.Worksheets
            wks.Unprotect cPassword
        Next
        wkb.Save
        wkb.Close
    Next    
End Sub

Sub ExtractFolder(Folder As String, arr() As String)
    Dim i As Long, objFS As Object, objFolder As Object, obj As Object
    
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(Folder)

    For Each obj In objFolder.SubFolders
        ExtractFolder obj.Path, arr()
    Next

    For Each obj In objFolder.Files
        If obj.Name Like cFileFilter Then
            On Error Resume Next
            i = 0: i = UBound(arr) + 1
            On Error GoTo 0
            ReDim Preserve arr(i)
            arr(i) = objFolder.Path & Application.PathSeparator & obj.Name
        End If
    Next
End Sub
Is there anyone who can correct the VBA in attached the workbook or maybe a completed macro or link to the web where I can find the VBA code.
Thanks for any help.
 

Attachments

  • MultipleBook.xlsx
    12.2 KB · Views: 2
1 : via Application.FileDialog(msoFileDialogFolderPicker)
2 & 5 : via the Dir VBA function (see its sample in VBA inner help).​
3 : via Worksheets("Protection").Unprotect …​
 
Hi @Marc L
Thank you for answer.
Elaborate the bold part …
The idea is to have two variants. With password and without password. But it doesn't matter anymore.
Eventually I realized that it was enough about changing 'Unprotect' to 'Protect'.

I'll try your advice.
 
Back
Top