Mở khóa tệp Excel bằng VBA

Đôi khi người dùng quên mật khẩu đã khóa tệp excel và phải tìm kiếm cách mở tệp excel.

Bài viết hôm nay mình chia sẽ cách giúp bạn mở khóa tệp excel khi bạn bị quên mật khẩu.

Phần I: Unlock Sheet, Workbooks

Bước 1: Mở tệp Excel cần được mở khóa, sau đó nhấn Alt + F11 để mở cửa sổ VBA.

Bước 2: Chọn tùy chọn Insert => Module

Bước 3: Khi cửa sổ chung bật lên, đó là nơi bạn nhập mã VBA.

Đoạn mã 1:

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

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

'''Paste this code in Module2 and run it

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

Đoạn mã 2:

Public Sub AllInternalPasswords()
        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
          w1.Unprotect PWord1
        Next w1
        On Error GoTo 0
        ShTag = False
        For Each w1 In Worksheets
          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
                      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

Bước 4: Nhấp vào nút “Run” (hoặc nhấn phím F5) để chạy.

Bước 5: Trong vài giây và done!

Phần II: Unlock VBA Project

Cách 1:

Đầu tiên, chúng ta sẽ cần tải xuống một trình soạn thảo Hex. Nếu bạn chưa có, HxD (ứng dụng soạn thảo mã hex) sẽ là một lựa chọn thay thế miễn phí khá ổn.

Tải HxD

Quá trình này sẽ có một chút khác biệt tùy thuộc vào việc chúng ta đang crack mật khẩu trong file XLS cũ hay file XLSM mới. Nếu bạn đang làm việc với file cũ, bạn có thể bỏ qua phần dưới đây.

Chuẩn bị file XLSM

Chúng ta cần thực hiện thêm một số công tác chuẩn bị để xóa mật khẩu khỏi file XLSM. Tìm file XLSM trên ổ cứng, sau đó đổi tên cho nó, thêm đuôi .zip vào cuối.

Tiếp theo, mở file bằng phần mềm nén như WinRAR hoặc 7-Zip. Bạn nên tìm một thư mục có tên xl.

Tìm thư mục có tên xl

Trong thư mục này, bạn cần tìm kiếm một tập tin có tên vbaProject.bin.

Tìm kiếm một tập tin có tên vbaProject.bin

Trích xuất tập tin này và mở nó bằng Hex Editor.

Vô hiệu hóa mật khẩu

Đây là lúc thiết lập mật khẩu khác. Tạo một tài liệu Excel ảo, thêm Macro vào nó và thiết lập mật khẩu như đã mô tả ở phần trên. Tiếp theo, chúng ta sẽ lấy mã Hex quy định mật khẩu và chèn nó vào trong file mà chúng ta muốn truy cập.

Khi bạn đã thiết lập tập tin đó, lưu nó lại và thực hiện giống như quy trình kết thúc file vbaProject.bin ở trên. Hãy nhớ mật khẩu nhé!

Bây giờ, bạn sẽ có cả hai file vbaProject.bin cùng mở trong Hex Editor.

Sử dụng Ctrl + F trong file bạn đã tạo để tìm chuỗi dưới đây:

CMG=

Đây là sự khởi đầu của code quy định mật khẩu hiện tại. Chúng ta cần sao chép và dán 3 giá trị sau:

CMG=
DPB=
GC=

Dưới đây bạn có thể thấy cách tôi thực hiện.

Chép và dán 3 giá trị trong hình

Chuyển code này sang file vbaProject.bin khác và đặt nó trong vị trí tương ứng. Lưu file hex đã chỉnh sửa lại.

Giờ thì xóa file vbaProject.bin gốc khỏi tài liệu mà chúng ta đang cố gắng loại bỏ mật khẩu. Thay thế nó bằng tệp vbaProject.bin đã được chỉnh sửa, sau đó, đổi tên tệp của nó từ .zip sang .xlms hoặc .xls.

Mở tệp trong Excel. Trở lại tab Developer và nhấn Visual Basic, sau đó thử truy cập menu Project. Bạn sẽ thấy cửa sổ nhắc nhập mật khẩu, mật khẩu ở đây chính là cái mà chúng ta đã thiết lập trong tài liệu Excel ảo.

Nhập mật khẩu

Vậy là bạn có thể truy cập lại tập tin rồi.

Cách 2:

Tương tự cách mở khóa sheet/workbook bạn mở cửa sổ vba lên để chạy code. Khác 1 xíu là do vba file cần mở bị khóa nên bạn mở 1 file trắng khác để có thể thêm code vba.

Đoạn mã unlock vba project:

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
        ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
        ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                           hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function