Home > Back-end >  Excel VBA Macro to Open, Protect, Save and Close Multiple Files in a Folder
Excel VBA Macro to Open, Protect, Save and Close Multiple Files in a Folder

Time:10-29

There.

I need to run an Excel VBA macro that will open 50 .xlsx files in a single folder, one by one I suppose, protect the sheet, save and close.

I would love a dialog that tells me how many files found to first confirm the number of files in the folder.

Here's the code that has been suggested to me to open, protect, save and close a single file (however, again, I am looking to do this for 50 or so multiple files).

Sub Macro1()
'
' Macro1 Macro
'

'
    ChDir "G:\Folder\Subfolder\Projects"
    Workbooks.Open Filename:= _
        "G:\Folder\Subfolder\Projects\Filename.xlsx"
            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub

Can this be modified, or do I need new code? Can someone help me?

Thank you!

CodePudding user response:

This should do the trick.

Sub protect_excel_files_sheets_in_folder()

Dim wb As Workbook
Dim sheet As Worksheet
Dim file_path As String, work_file As String, file_types As String
Dim work_folder As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .ButtonName = "Select"
    .Show

    If .SelectedItems.Count <> 1 Then
        GoTo CleanExit
    End If

    work_folder = .SelectedItems(1) & "\"
End With

file_types = "*.xls*"

work_file = Dir(work_folder & file_types)

Do While work_file <> ""
    Set wb = Workbooks.Open(Filename:=work_folder & work_file)
        For Each sheet In wb.Sheets
            sheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
        Next
        Sheets(0).Activate
    wb.Close SaveChanges:=True
    work_file = Dir
Loop
CleanExit:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I just happen to have something similar, to password protect and unprotect all file and sheets, in my library. I took out the password part and it should work for you.

CodePudding user response:

Thank you! This works. :-)... although I commented out one line in order to run: Sheets(0).Activate... my workbooks only have one sheet, so seems to work. If you have an idea why this would have thrown an error, let me know, else I'll run with the fact that it works without. Can't thank you enough!

  • Related