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