EXCEL文件密码通过宏破解

1:视图---宏----录制新宏---输入名字:任意起或用默认名都可

2:停止录制(这样得到一个空宏)
3:视图---宏----宏,选择之前录制的宏,点编辑按钮
4:删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧,注意复制粘贴完如下内容后,里面红色语句中会有空行,把红色语句中空行都去掉再执行否则会有语法错误),然后关闭编辑窗口
5:视图---宏-----宏,选AllInternalPasswords,运行,确定两次,(有可能这里要再稍等会),再确定.OK,没有密码了!!

(题外:完成后,可以选择审视再将其保护起来,将之前操作的宏删除)



Option Explicit



Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob McCormick
' probably originator of base code algorithm modified for coverage
' of workbook structure / windows passwords and for multiple passwords
'
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords





Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."

  • 0
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
1、打开任一excel文件 2、在里粘贴下面的代码 3、运行下面的代码 4、选择需要破解密码文件 5、点击“打开” '移除VBA编码保护 Sub MoveProtect() Dim FileName As String FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla&*.xlsx),*.xls;*.xla;*.xlsx", , "VBA破解") If FileName = CStr(False) Then Exit Sub Else VBAPassword FileName, False End If End Sub '设置VBA编码保护 Sub SetProtect() Dim FileName As String FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla&*.xlsx),*.xls;*.xla;*.xlsx", , "VBA破解") If FileName = CStr(False) Then Exit Sub Else VBAPassword FileName, True End If End Sub Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False) If Dir(FileName) = "" Then Exit Function Else FileCopy FileName, FileName & ".bak" End If Dim GetData As String * 5 Open FileName For Binary As #1 Dim CMGs As Long Dim DPBo As Long For i = 1 To LOF(1) Get #1, i, GetData If GetData = "CMG=""" Then CMGs = i If GetData = "[Host" Then DPBo = i - 2: Exit For Next If CMGs = 0 Then MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示" Exit Function End If If Protect = False Then Dim St As String * 2 Dim s20 As String * 1 '取得一个0D0A十六进制字串 Get #1, CMGs - 2, St '取得一个20十六制字串 Get #1, DPBo + 16, s20 '替换加密部份机码 For i = CMGs To DPBo Step 2 Put #1, i, St Next '加入不配对符号 If (DPBo - CMGs) Mod 2 0 Then Put #1, DPBo + 1, s20 End If MsgBox "文件解密成功......", 32, "提示" Else Dim MMs As String * 5 MMs = "DPB=""" Put #1, CMGs, MMs MsgBox "对文件特殊加密成功......", 32, "提示" End If Close #1 End Function

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值