已知工作簿打开密码，如何批量解密工作簿

right1406

各位大侠啊！！

已知工作簿打开密码（每个工作簿打开密码不一致），如何批量解密，打开时不需要一个一个输入密码？

附件中，解密.xls是每个工作簿的名称和打开密码。
                                                                                                                                                                                                         

everbest2015

Sub 批量解除密码()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Dim mypath$, myfile$, i%, wb As Workbook, myname$, wkb As Workbook
    Set wb = ThisWorkbook: mypath = wb.Path & "\"
    myfile = Dir(mypath & "*.xls*")
    Do While myfile <> ""
        If myfile <> wb.Name Then
            myname = Left(myfile, VBA.InStr(myfile, ".") - 1)
            i = Application.WorksheetFunction.Match(myname, wb.Sheets(1).Range("c:c"), 0)
            Workbooks.Open mypath & myfile, , , , wb.Sheets(1).Range("d" & i).Value
            Set wkb = ActiveWorkbook
            With wkb
                .Password = ""
                .Save
                .Close False
            End With
        End If
        myfile = Dir
    Loop
    MsgBox "当前文件夹内的工作簿的密码已被全部清除!", , ""
    Application.Quit
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub