VBA宏批量保护Excel文件工作表

选择目录，设置自定义密码，可对该目录以及其中子目录添加保护：

    Dim folderPath As String
    Dim password As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim file As String
    Dim subFolder As Object
    Dim fso As Object
    
    ' 弹窗选择目录
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择目录"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        folderPath = .SelectedItems(1)
    End With
    
    Debug.Print "选择的目录: " & folderPath
    
    ' 弹窗输入密码
    password = InputBox("请输入保护密码:", "密码输入")
    
    Debug.Print "输入的密码: " & password
    
    ' 创建 FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历目录中的Excel文件
    file = Dir(folderPath & "\*.xls*")
    Do While file <> ""
        Debug.Print "当前文件: " & file
        Set wb = Workbooks.Open(folderPath & "\" & file)
        For Each ws In wb.Worksheets
            ws.Protect Password:=password, DrawingObjects:=True, Contents:=True, Scenarios:=True
        Next ws
        wb.Close SaveChanges:=True
        file = Dir
    Loop
    
    ' 遍历子目录中的Excel文件
    Set subFolder = fso.GetFolder(folderPath)
    For Each subFolder In subFolder.SubFolders
        ProtectWorksheetsInSubFolder subFolder.Path, password
    Next subFolder
    
    MsgBox "操作完成！", vbInformation
End Sub

Sub ProtectWorksheetsInSubFolder(folderPath As String, password As String)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim file As String
    
    ' 创建 FileSystemObject
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历子目录中的Excel文件
    file = Dir(folderPath & "\*.xls*")
    Do While file <> ""
        Debug.Print "当前子目录文件: " & file
        Set wb = Workbooks.Open(folderPath & "\" & file)
        For Each ws In wb.Worksheets
            ws.Protect Password:=password, DrawingObjects:=True, Contents:=True, Scenarios:=True
        Next ws
        wb.Close SaveChanges:=True
        file = Dir
    Loop
End Sub