|
楼主 |
发表于 2024-8-6 09:43
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
依葫芦画瓢,根据大神的加密代码,改成解密的代码以供大家使用。
- Sub ykcbfjm() '//2024.8.5 工作簿加密
-
- On Error GoTo err
- Dim fn, wb
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set d = CreateObject("Scripting.Dictionary")
- p = ThisWorkbook.Path & ""
- r = Cells(Rows.Count, 1).End(3).Row
- For i = 2 To r
- s = Cells(i, 1)
- If s <> Empty Then d(s) = Array(Cells(i, 2), Cells(i, 3))
- Next
- For Each f In fso.GetFolder(p).Files
- If LCase$(f.Name) Like "*.xls*" Then
- If InStr(f.Name, ThisWorkbook.Name) = 0 Then
- fn = fso.GetBaseName(f)
- fx = fso.GetExtensionName(f)
- If InStr(fx, "xlsx") Then mm = 51 Else mm = 56
- If d.exists(fn) Then
- pw = d(fn)(0)
- rw = d(fn)(1)
- With Workbooks.Open(f, , , , pw, rw)
- .SaveAs Filename:=f, FileFormat:=mm, Password:="", WriteResPassword:=""
- .Close
- End With
- End If
- End If
- End If
- Next f
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- MsgBox "处理完毕!"
- Exit Sub
- err: MsgBox "密码错误!"
- End Sub
复制代码
|
|