Posted Updated Programming / Excel|VBA0 visits

VBA_ Excel password unprotect 암호해제


어쩔 수 없이 암호해제를 해야 할 때가 있습니다.

  • 코딩을 하다보면 남이 만든 소스가 궁금하다거나
  • 실행은 잘 되지만 과정상에 예외처리를 제대로 하지 않은 소스코드나 실행시 실행대상의 Cell / Range 지정을 바꾸어야 할 때

그리고 엑셀의 암호는 2가지 종류가 있습니다.

  • 첫 번째는 VBA에 걸린 암호
  • 두 번째는 엑셀시트(SHEET)에 걸린 암호

아래 매크로들은 암호를 해제할 뿐, 암호를 변경해주는 것이 아니기에 수정할 사항만 고치고 저장하기를 하면 원본작성자가 걸어둔 암호는 그대로 유지됩니다. 이 방법이 어떨 때는 더 편할 때도 있습니다.
내가 만든 엑셀조차도 암호해제 > 내용 수정 > 암호 복구의 순서로 작업해야 하는데 이보다 일괄 암호해제 > 수정 > 저장 순서가 더 간편합니다. 그렇기에 개인 매크로 파일personal.xlsb 에 저장해 두고 필요할 때 꺼내쓰면 좋습니다.




1) VBA 암호해제

https://stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-password-on-an-excel-vba-project/31005696#31005696

Stackoverflow의 답변의 코드가 인터넷에서 구한 코드들 중에서 가장 잘 작동합니다.
아래 코드를 모듈에 붙여넣고 “unprotected” 매크로를 실행합니다.

VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Option Explicit
Private Const PAGE_EXECUTE_READWRITE = &H40
 
Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
 
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
 
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
 
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
ByVal lpProcName As String) As LongPtr
 
Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
 
Dim HookBytes(0 To 11) As Byte
Dim OriginBytes(0 To 11) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean
 
 
''''''''for VBA unpassword
Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub
 
'''''''
Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
    GetPtr = Value
End Function
 
Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 12
End Sub
 
Public Function Hook() As Boolean
    Dim TmpBytes(0 To 11) As Byte
    Dim p As LongPtr, osi As Byte
    Dim OriginProtect As LongPtr
 
    Hook = False
 
    #If Win64 Then
        osi = 1
    #Else
        osi = 0
    #End If
 
    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
 
    If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
 
        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, osi + 1
        If TmpBytes(osi) <> &HB8 Then
 
            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12
 
            p = GetPtr(AddressOf MyDialogBoxParam)
 
            If osi Then HookBytes(0) = &H48
            HookBytes(osi) = &HB8
            osi = osi + 1
            MoveMemory ByVal VarPtr(HookBytes(osi)), ByVal VarPtr(p), 4 * osi
            HookBytes(osi + 4 * osi) = &HFF
            HookBytes(osi + 4 * osi + 1) = &HE0
 
            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12
            Flag = True
            Hook = True
        End If
    End If
End Function
 
Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
 
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function





2) Sheet 보호해제

  • 활성화 시트만 해제
VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub PasswordBreaker()
    'Breaks worksheet password protection.
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
        Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
        Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub




  • All Sheet 해제

시트를 복사하거나 내부 링크경로가 바뀌어서 일괄 수정하려고 할 때 (Ctrl + H), 1페이지라도 시트보호가 걸려 있다면 일괄수정이 되지 않습니다. 여러 시트로 구성된 엑셀 파일에 어느 부분이 보호가 되어 있고 패스워드를 알지 못할 때 아래 매크로를 사용하면 모든 시트를 암호해제 합니다. 단, 시간이 오래 걸립니다.

http://www.mcgimpsey.com/excel/removepwords.html

VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
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."
    Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
        "now be free of all password protection, so make sure you:" & _
        DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
        DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
        DBLSPACE & "Also, remember that the password was " & _
        "put there for a reason. Don't stuff up crucial formulas " & _
        "or data." & DBLSPACE & "Access and use of some data " & _
        "may be an offense. If in doubt, don't."
    Const MSGNOPWORDS1 As String = "There were no passwords on " & _
        "sheets, or workbook structure or windows." & AUTHORS & VERSION
    Const MSGNOPWORDS2 As String = "There was no protection to " & _
        "workbook structure or windows." & DBLSPACE & _
        "Proceeding to unprotect sheets." & AUTHORS & VERSION
    Const MSGTAKETIME As String = "After pressing OK button this " & _
        "will take some time." & DBLSPACE & "Amount of time " & _
        "depends on how many different passwords, the " & _
        "passwords, and your computer's specification." & DBLSPACE & _
        "Just be patient! Make me a coffee!" & AUTHORS & VERSION
    Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
        "Structure or Windows Password set." & DBLSPACE & _
        "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
        "Note it down for potential future use in other workbooks by " & _
        "the same person who set this password." & DBLSPACE & _
        "Now to check and clear other passwords." & AUTHORS & VERSION
    Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
        "password set." & DBLSPACE & "The password found was: " & _
        DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
        "future use in other workbooks by same person who " & _
        "set this password." & DBLSPACE & "Now to check and clear " & _
        "other passwords." & AUTHORS & VERSION
    Const MSGONLYONE As String = "Only structure / windows " & _
         "protected with the password that was just found." & _
         ALLCLEAR & AUTHORS & VERSION & REPBACK
    Dim w1 As Worksheet, w2 As Worksheet
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
    Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
    Dim PWord1 As String
    Dim ShTag As Boolean, WinTag As Boolean
    
    Application.ScreenUpdating = False
    With ActiveWorkbook
        WinTag = .ProtectStructure Or .ProtectWindows
    End With
    ShTag = False
    For Each w1 In Worksheets
        ShTag = ShTag Or w1.ProtectContents
    Next w1
    If Not ShTag And Not WinTag Then
        MsgBox MSGNOPWORDS1, vbInformation, HEADER
        Exit Sub
    End If
    MsgBox MSGTAKETIME, vbInformation, HEADER
    If Not WinTag Then
        MsgBox MSGNOPWORDS2, vbInformation, HEADER
    Else
        On Error Resume Next
        Do        'dummy do loop
        For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
        For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
        For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
        For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
        With ActiveWorkbook
            .Unprotect Chr(i) & Chr(j) & Chr(k) & _
         Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
         Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
            If .ProtectStructure = False And _
            .ProtectWindows = False Then
            PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
            Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
            Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
            MsgBox Application.Substitute(MSGPWORDFOUND1, _
            "$$", PWord1), vbInformation, HEADER
            Exit Do    'Bypass all for...nexts
            End If
        End With
        Next: Next: Next: Next: Next: Next
        Next: Next: Next: Next: Next: Next
        Loop Until True
        On Error GoTo 0
    End If
    If WinTag And Not ShTag Then
        MsgBox MSGONLYONE, vbInformation, HEADER
        Exit Sub
    End If
    On Error Resume Next
    For Each w1 In Worksheets
        'Attempt clearance with PWord1
        w1.Unprotect PWord1
    Next w1
    On Error GoTo 0
    ShTag = False
    For Each w1 In Worksheets
        'Checks for all clear ShTag triggered to 1 if not.
        ShTag = ShTag Or w1.ProtectContents
    Next w1
    If ShTag Then
        For Each w1 In Worksheets
            With w1
        If .ProtectContents Then
            On Error Resume Next
            Do        'Dummy do loop
            For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
            For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
            For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
            For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
            .Unprotect Chr(i) & Chr(j) & Chr(k) & _
                Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
            If Not .ProtectContents Then
                PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
            Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
            Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                MsgBox Application.Substitute(MSGPWORDFOUND2, _
                "$$", PWord1), vbInformation, HEADER
                'leverage finding Pword by trying on other sheets
                For Each w2 In Worksheets
            w2.Unprotect PWord1
                Next w2
                Exit Do    'Bypass all for...nexts
            End If
            Next: Next: Next: Next: Next: Next
            Next: Next: Next: Next: Next: Next
            Loop Until True
            On Error GoTo 0
        End If
            End With
        Next w1
    End If
    MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub







#

Like this article? Support the author with

Comments

Home

Catalogue

Categories

Links

You need to set client_id and slot_id to show this AD unit. Please set it in _config.yml.
×