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

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

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