1 Sub VBAPassword()
2 '你要解保护的Excel文件路径
3 Filename = Application.GetOpenFilename("Excel文件(*.xls & *.xla & *.xlt),*.xls;*.xla;*.xlt", , "VBA破解")
4
5 If Dir(Filename) = "" Then
6 MsgBox "没找到相关文件,清从新设置。"
7 Exit Sub
8 Else
9 FileCopy Filename, Filename & ".bak" '备份文件。
10 End If
11
12 Dim GetData As String * 5
13 Open Filename For Binary As #1
14 Dim CMGs As Long
15 Dim DPBo As Long
16 For i = 1 To LOF(1)
17 Get #1, i, GetData
18 If GetData = "CMG=""" Then CMGs = i
19 If GetData = "[Host" Then DPBo = i - 2: Exit For
20 Next
21
22 If CMGs = 0 Then
23 MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
24 Exit Sub
25 End If
26
27 Dim St As String * 2
28 Dim s20 As String * 1
29 '取得一个0D0A十六进制字串
30 Get #1, CMGs - 2, St
31 '取得一个20十六制字串
32 Get #1, DPBo + 16, s20
33 '替换加密部份机码
34 For i = CMGs To DPBo Step 2
35 Put #1, i, St
36 Next
37
38 '加入不配对符号
39 If (DPBo - CMGs) Mod 2 <> 0 Then
40 Put #1, DPBo + 1, s20
41 End If
42 MsgBox "文件解密成功......", 32, "提示"
43 Close #1
44 End Sub