Here is one for the Code Library.
Somehow I end up misplacing this bit of code. So every time I need to do it, I end up re-writing it.
Perhaps I’ll save someone the same frustration along the way.
This code snippet will loop through each file in your folder (and subfolders).
For each workbook opened, it will unprotect each worksheet using the supplied password.
Const cStartFolder = “D:MySecretSpreadsheets” ‘no slash at end
Const cFileFilter = “*.xls”
Const cPassword = “trustno1”
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
Const cFileFilter = “*.xls”
Const cPassword = “trustno1”
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
(if this appears twice, I apologize)
Here’s the code I’ve been using for a year or so now to unprotect workbooks and worksheets:
Public Sub WorkBookUnprotect(wrkbk)
On Error Resume Next
With Workbooks(wrkbk)
.Protect vbNullString, True, True
.Unprotect vbNullString
End With
End Sub
Public Sub WorkSheetUnprotect(wrkbk, wrksht)
On Error Resume Next
With Workbooks(wrkbk).Worksheets(wrksht)
.Protect vbNullString, , , , True
.Range(“A1?).Copy .Range(“A1?)
.Unprotect vbNullString
End With
End Sub
Nick …the Workbook uprotect will not work from XP onwards.
The Worksheet unprotect will work upto 2003…havent tested it in 2007
Rob,
Tried the module for a set of 94 workbooks in one folder, each with a single worksheet.
My aim was to unprotect workbooks and worksheets and then concatenate the workbooks into a combined workbook of 94 worksheets and then create an index page for the workbook contents with hyperlinks to the worksheets..
The macro worked for unprotecting all the worksheets, but no workbook was unprotected.
The concatenate macro only works with unprotected workbooks.
I am using Office 2003.
Any more information possible in this regard?
Seshadri