Unprotect & Protect multiple excel files with multiple worksheets

[kalagas]

Hello everybody....
Here is my problem. I have found some vba that may do the trick i want but none of them in the way i need it.
So here is the description. I have multiple excel files in a folder and subfolders. I DON't protect the workbooks (excel files) but only the worksheets, all with the same password (f.e password=123456).
So i need a vba that when i run it, it will open a windows explorer to select the folder i want. Then open all workbooks inside the folder i choose (and its subfolders), unprotect all the worksheets of each workbook, save it and close it.

The reason i need a popup window when i run the vba so i can choose the folder, is that i use folders names with greek characters. So all the vba i found you have to put the path of the folder inside vba f.e:
cStartFolder = "C:\myfolder" 'no slash at end

So when i copy my path f.e:
C:\OneDrive\ΑΠΟΘΗΚΗ\Ε ΔΠ-10.06 (ΩΡΑΡΙΑ ΕΡΓΑΣΙΑΣ) ΑΠΟΘΗΚΗ\TEST
and paste it in vba, it becomes:
C:\OneDrive\ΑΠΟΘΗΚΗ\Ε ΔΠ-10.06 (ΩΡΑΡΙΑ ΕΡΓΑΣΙΑΣ) ΑΠΟΘΗΚΗ\TEST

and because i have to change many files in many folders it will take me a lot of time to change the path manually by writing all of it every time.

P.S i also would like the above same vba but to protect all sheets of multiple workbooks in a folder and its subfolders. So the reverse procedure.

Thanks in advance everyone for your time.

 

[DanteAmor]

To un protect:

Sub Unprotect_worksheets()
    Dim wb As Workbook, ws As Worksheet
    Dim wPath As String, wQuan As Long, n As Long
    Dim fso As Object, folder As Object, subfolder As Object, wFile As Object
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.StatusBar = False
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        wPath = .SelectedItems(1)
    End With


    Set fso = CreateObject("scripting.filesystemobject")
    Set folder = fso.getfolder(wPath)
    
    wQuan = folder.Files.Count
    n = 1
    For Each wFile In folder.Files
        Application.StatusBar = "Processing folder : " & folder & ". File : " & n & " of : " & wQuan
        If Right(wFile, 4) Like "*xls*" Then
            Set wb = Workbooks.Open(wFile)
            For Each ws In wb.Sheets
                ws.Unprotect "123456"
            Next
            wb.Close True
        End If
        n = n + 1
    Next
    
    For Each subfolder In folder.subfolders
        wQuan = subfolder.Files.Count
        n = 1
        For Each wFile In subfolder.Files
            Application.StatusBar = "Processing folder : " & subfolder & ". File : " & n & " of : " & wQuan
            If Right(wFile, 4) Like "*xls*" Then
                Set wb = Workbooks.Open(wFile)
                For Each ws In wb.Sheets
[COLOR=#0000ff]                    ws.Unprotect "123456"[/COLOR]
                Next
                wb.Close True
            End If
            n = n + 1
        Next
    Next
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    
    Set fso = Nothing: Set folder = Nothing: Set wb = Nothing
    
    MsgBox "End"
End Sub

To Protect, change ws.Protect "123456" and the desired password

 

[kalagas]

Thank you a lot. I will try it tomorrow and will give feedback. Thanks again for your time.

 

[DanteAmor]

Don't worry. Let me know if you have any problems.

 

[kalagas]

Ok i test it and it works like charm... Thanks again.
So if you can help me in one more thing (in one more vba actually) i would be great-full.

The reason i needed to Unprotect all sheets of all files at once, is because i need to run a "find and replace" vba in all these files and their Sheet names. And as i have read in many threads "find and replace" vba, won't work if sheets are protected.

So the excel files was for the season 2018. So i would like a vba again to open all the excel files in a folder (and its subfolders) in same way (to select the folder from windows explorer popup window) and find "2018" and replace it with "2019". But "2018" is in many cells of each sheet and also in sheets names of each workbook.

So if its possible to make a vba for search "2018" both in cells of each sheet and sheets names of each workbook and replace it with "2019".

I dont know if i need 2 different vba. One to replace "2018" with "2019" in all cells of each sheet and one to replace "2018" with "2019" in all sheets names of each workbook.

Thanks in advanced. I am now learning excel macros but i I still have a long way to go and unfortunately i have to make these changes in about 900 files until next week.

 

[kalagas]

Don't worry. Let me know if you have any problems.

Ok i test it and it works like charm... Thanks again.
So if you can help me in one more thing (in one more vba actually) i would be great-full.

The reason i needed to Unprotect all sheets of all files at once, is because i need to run a "find and replace" vba in all these files and their Sheet names. And as i have read in many threads "find and replace" vba, won't work if sheets are protected.

So the excel files was for the season 2018. So i would like a vba again to open all the excel files in a folder (and its subfolders) in same way (to select the folder from windows explorer popup window) and find "2018" and replace it with "2019". But "2018" is in many cells of each sheet and also in sheets names of each workbook.

So if its possible to make a vba for search "2018" both in cells of each sheet and sheets names of each workbook and replace it with "2019".

I dont know if i need 2 different vba. One to replace "2018" with "2019" in all cells of each sheet and one to replace "2018" with "2019" in all sheets names of each workbook.

Thanks in advanced. I am now learning excel macros but i I still have a long way to go and unfortunately i have to make these changes in about 900 files until next week.

 

[sofas]

To un protect:

Sub Unprotect_worksheets()
    Dim wb As Workbook, ws As Worksheet
    Dim wPath As String, wQuan As Long, n As Long
    Dim fso As Object, folder As Object, subfolder As Object, wFile As Object
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.StatusBar = False
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        wPath = .SelectedItems(1)
    End With


    Set fso = CreateObject("scripting.filesystemobject")
    Set folder = fso.getfolder(wPath)
   
    wQuan = folder.Files.Count
    n = 1
    For Each wFile In folder.Files
        Application.StatusBar = "Processing folder : " & folder & ". File : " & n & " of : " & wQuan
        If Right(wFile, 4) Like "*xls*" Then
            Set wb = Workbooks.Open(wFile)
            For Each ws In wb.Sheets
                ws.Unprotect "123456"
            Next
            wb.Close True
        End If
        n = n + 1
    Next
   
    For Each subfolder In folder.subfolders
        wQuan = subfolder.Files.Count
        n = 1
        For Each wFile In subfolder.Files
            Application.StatusBar = "Processing folder : " & subfolder & ". File : " & n & " of : " & wQuan
            If Right(wFile, 4) Like "*xls*" Then
                Set wb = Workbooks.Open(wFile)
                For Each ws In wb.Sheets
[COLOR=#0000ff]                    ws.Unprotect "123456"[/COLOR]
                Next
                wb.Close True
            End If
            n = n + 1
        Next
    Next
   
    Application.ScreenUpdating = True
    Application.StatusBar = False
   
    Set fso = Nothing: Set folder = Nothing: Set wb = Nothing
   
    MsgBox "End"
End Sub

To Protect, change ws.Protect "123456" and the desired password

How can a password be added to all files in the same way