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.
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.
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
Thanks for any help.