如何解决我在特定文件位置有 100 个受密码保护的 excel 工作簿2016,我必须有 2 个密码才能解锁它们
以下代码可用于从多个 excel 文档中删除 1 个已知密码,但是如果文件夹中的文件没有正确的密码,则代码将不会继续遍历剩下的文件。有 2 个已知密码“191034”和“211034”,它们涵盖了文件夹中所有受密码保护的文档。是否可能有 1 段代码可以循环遍历测试两个密码的文件,或者我是否需要编辑以下代码,以便在密码不正确时继续循环,然后使用另一个密码运行单独的代码?>
代码:
Sub RemovePasswords()
Dim xlBook As Workbook
Dim strFilename As String
Const fPath As String = "C:\Users\ha.smith\Documents\Excel Test\Test Files\CRU\" 'The folder to process,must end with "\"
Const strPassword As String = 211034 'case sensitive
Const strEditPassword As String = "" 'If no password use ""
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc
While Len(strFilename) <> 0
Application.DisplayAlerts = False
Set xlBook = Workbooks.Open(FileName:=fPath & strFilename,_
Password:=strPassword,_
WriteResPassword:=strEditPassword)
xlBook.SaveAs FileName:=fPath & strFilename,_
Password:="",_
WriteResPassword:="",_
CreateBackup:=False
xlBook.Close 0
Application.DisplayAlerts = True
strFilename = Dir$()
Wend
End Sub
解决方法
您只需要给它一个密码列表并尝试所有密码。如果一个失败尝试另一个。
Option Explicit
Public Sub RemovePasswords()
Dim PasswordList() As Variant
PasswordList = Array("191034","211034") ' list your passwords
Const strEditPassword As String = "" 'If no password use ""
Const fPath As String = "C:\Temp\" 'The folder to process,must end with "\"
Dim strFilename As String
strFilename = Dir$(fPath & "*.xls") 'will open xls & xlsx etc
Do While Len(strFilename) <> 0
Application.DisplayAlerts = False
Dim strPassword As Variant
For Each strPassword In PasswordList ' loop through password list and try them all
On Error Resume Next ' prevent error if wrong password is used
Dim xlBook As Workbook
Set xlBook = Workbooks.Open(Filename:=fPath & strFilename,_
Password:=strPassword,_
WriteResPassword:=strEditPassword)
If Err.Number = 0 Then ' if password was correct save the file
On Error GoTo 0
xlBook.SaveAs Filename:=fPath & strFilename,_
Password:="",_
WriteResPassword:="",_
CreateBackup:=False
xlBook.Close 0
Exit For ' stop trying other passwords if the correct password was found.
End If
On Error GoTo 0
Next strPassword
Application.DisplayAlerts = True
strFilename = Dir$()
Loop
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。