Excel批量解密文件夹下密码一致的文件

Excel批量解密文件夹下密码一致的文件 工具下载地址： //download.csdn.net/download/qq_35866846/11990142 代码如下

代码语言：javascript复制

Option Explicit
Const pw As String = "123456"  '密码
Sub 批量解密()
    'Dim MyPath$
    Dim MyFileName, MyPath As String
    Dim MyBook As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择需解密文件所在文件夹"  '文件对话框的题目，根据个人情况进行设定
        .InitialFileName = "d:"       '默认打开的文件对话框路径，此处是d盘
        If .Show Then
                Application.ScreenUpdating = False
                Application.DisplayAlerts = False
            MyPath = .SelectedItems(1)  '获取到路径
            MyFileName = Dir(MyPath & "*.xls")
            Do Until MyFileName = ""
                Workbooks.Open MyPath & "" & MyFileName, Password:=pw, WriteRespassword:=pw
                MsgBox ("正在解密" & MyFileName)
                Set MyBook = ActiveWorkbook
                MyBook.Password = "" '撤销打开密码
                MyBook.WritePassword = "" '撤销写密码
                MyBook.Close True
                MyFileName = Dir
            Loop
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
        End If
    End With
End Sub

download excel 工具

0 人点赞