查找xlsx文件批量加工作表保护

无雨谷

找了一段代码，遍历文件夹及子文件夹查找xlsx文件批量加工作表保护，运行没反应。好像子文件夹里不运行，请问大师如何改代码？ 测试.rar (37.58 KB, 下载次数: 2)

2023-5-31 17:53 上传

点击文件名下载附件

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=73cffde5
楼主参考下资料吧

liulang0808

Sub ProtectAllSheets()
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择文件夹"
        If .Show <> -1 Then Exit Sub
        pth = .SelectedItems(1)
    End With

    Application.ScreenUpdating = False
    Call Getfd(pth, fso)
    Application.ScreenUpdating = True
    MsgBox "完成"
End Sub

Sub Getfd(pth, fso)
    Set ff = fso.getfolder(pth)
    For Each f In ff.Files
        If fso.GetExtensionName(f) = "xlsx" Then
            Set wb = Workbooks.Open(f)
            For Each ws In wb.Worksheets
                ws.Protect Password:="969696"
            Next ws
            wb.Close SaveChanges:=True
        End If
    Next f
    For Each fd In ff.subfolders
        Call Getfd(fd, fso)
    Next fd
End Sub

liulang0808

附件内容供参考。。。。

无雨谷

liulang0808 发表于 2023-5-31 18:21
Sub ProtectAllSheets()
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Applicati ...

谢谢大师！