Xóa mật khẩu khỏi Tài liệu Excel

Tôi đang cung cấp hỗ trợ nội bộ và một trong những người dùng của chúng tôi đã vô tình đặt mật khẩu vào tệp excel, tôi đã thực hiện kiểm tra thích hợp để đảm bảo rằng người dùng sẽ có quyền truy cập vào tài liệu và bây giờ muốn biết những gì đề nghị xóa mật khẩu khỏi tài liệu Excel.

Để biết giá trị của nó, mật khẩu xuất hiện sau khi Excel mở nhưng trước khi bạn có thể thấy bất kỳ dữ liệu nào trong excel.

Elcomsoft tạo ra một chương trình khá hữu ích có tên Advanced Office Password Recovery , có thể thực hiện công việc tốt hơn bất kỳ thứ gì khác mà tôi đã sử dụng.

Có thể đáng để đặt một giá trị cho dữ liệu bạn đang cố khôi phục trước khi thử điều này, đôi khi sẽ ít tốn kém hơn khi cho phép người dùng tạo lại tài liệu từ đầu (và dạy cho họ một bài học quý giá ;-)). AOPR không miễn phí và đôi khi mật khẩu chỉ có thể được xử lý bằng vũ lực (thử mọi cách kết hợp các chữ cái có thể) có thể mất nhiều thời gian.

Là một cái gì đó như thế này, bổ trợ XLA của Công cụ xóa mật khẩu Excel , bạn sẽ làm gì sau đây?

EDIT: Suy nghĩ về nó, có thể không - điều này được sử dụng để xóa mật khẩu khỏi bảng tính / sổ làm việc được bảo vệ.

Nếu bạn biết mật khẩu là gì, hãy tiếp tục và mở tài liệu Excel. Sau đó bấm vào Tệp> Lưu dưới dạng. Ở bên trái của nút Lưu là một công cụ nhỏ có nhãn thả xuống. Bấm vào đó, và sau đó bấm vào Tùy chọn chung. Xóa các mục nhập mật khẩu ở đó, và bấm OK. Lưu tài liệu.

Nếu bạn không biết mật khẩu là gì, bạn có thể sử dụng VBA để tìm mật khẩu. Nếu tôi phải đoán, người dùng của bạn có thể đã không sử dụng mật khẩu siêu mạnh, vì vậy chúng tôi có thể sử dụng phương pháp loại vũ phu để tìm ra nó. Mã dưới đây là thô, nhưng nó đã giúp tôi tìm thấy một mật khẩu yếu, bị mất trên một số tài liệu của người dùng. Nó kiểm tra mật khẩu có độ dài bất kỳ với các ký tự ASCII từ 1 đến z. Bạn sẽ gọi nó từ Cửa sổ ngay lập tức và đợi vài phút như vậy:

? GetPassword("D:\mywkbk.xlsx")

-

Public Function GetPassword(ByRef sFileName As String) As String
On Error Resume Next
    Dim pw As String
    pw = ""
    Do
        VBA.Err.Clear
        pw = GenerateNextPassword(pw)            
        Application.Workbooks.Open sFileName, False, True, , pw, pw
        VBA.DoEvents
    Loop While VBA.Err.Number = 5408
    GetPassword = pw
End Function

Public Function GenerateNextPassword(ByRef sCurrentPassword As String) As String
    Const MAX_CHAR = 122
    Const MIN_CHAR = 49

    Dim sCurrentPasswordMax As String
    Dim sNewPassword As String
    Dim i As Long

    sCurrentPasswordMax = String(Len(sCurrentPassword), Chr(MAX_CHAR))
    If sCurrentPassword = sCurrentPasswordMax Then
        'do an increment that changes the length
        sNewPassword = String(Len(sCurrentPassword) + 1, Chr(MIN_CHAR))
        Debug.Print Now(); ": "; sNewPassword
    ElseIf Asc(Right(sCurrentPassword, 1)) = MAX_CHAR Then
        'do an increment that changes multiple characters
        sNewPassword = Left(sCurrentPassword, Len(sCurrentPassword) - 1) & Chr(MIN_CHAR)
        For i = Len(sCurrentPassword) - 1 To 1 Step -1
            sNewPassword = Left(sNewPassword, i - 1) & Chr(Asc(Mid(sNewPassword, i, 1)) + 1) & Mid(sNewPassword, i + 1)
            If Asc(Mid(sCurrentPassword, i, 1)) <> MAX_CHAR Then
                Exit For
            End If
        Next i
    Else
        'do an increment on the rightmost character
        sNewPassword = Left(sCurrentPassword, Len(sCurrentPassword) - 1) & Chr(Asc(Right(sCurrentPassword, 1)) + 1)
    End If

    GenerateNextPassword = sNewPassword
End Function

Cách tiếp cận Hook thể hiện trong bài viết SO này hoạt động MERYI LẦN.

/programming//a/27508116/5757159

Không có trình soạn thảo Hex, không tải xuống, không có trình cài đặt. Chỉ là một giải pháp VBA thuần túy.