excel vba通过测试多个密码来打开工作簿

Question

I have password-protected .xls files in a directory. I would like to open each of these files and save them without the password.

However, the files can be opened by using either of the sample passwords listed below.

pwd1 = "123"
pwd2 = "456"
pwd3 = "789"

'Check if pwd1 opens
Application.Workbooks.Open(Filename:=fn, Password:=pwd1)

'If fail then use pwd2
Application.Workbooks.Open(Filename:=fn, Password:=pwd2)

'and so on..

How should I implement this?

Answer 1

Once the file has been opened once, you only need to Unprotect it. This will save a lot of time, instead of constantly opening/closing workbooks.

Here's how I'd do it:

Public Sub CrackWorkbook()
    Dim fn As String
    fn = "C:\Temp\test_password_is_456.xlsx"

    Dim wb As Workbook
    Set wb = Workbooks.Open(fn)

    Dim lst As Variant
    lst = Array("123", "456", "789")

    Dim item As Variant
    For Each item In lst
        On Error GoTo did_not_work
        Call wb.Unprotect(item)
        Call wb.Save
        Call wb.Close(False)
        Exit Sub
did_not_work:
        On Error GoTo 0
    Next item
End Sub

In other words, create an array of strings and do a For Each on them, and set some error-handling to deal with all the failed attempts.

I know GoTo statements are a bit yucky, but that's the best way to handle errors in VBA (as far as I know).

Answer 2

I tried @lebelinoz answer however the routine gives a 1004 error. I googled this behavior and found this post: https://stackoverflow.com/questions/21176638/vba-how-to-force-ignore-continue-past-1004-error

The code below works by using On Error Resume Next . I based this on @lebelinoz answer.

Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"

Dim wb As Workbook
Dim item As Variant
Dim lst As Variant

lst = Array("123", "456", "789")

For Each item In lst
    On Error Resume Next
    Workbooks.Open Filename:=fn, Password:=item
If Err.Number <> 0 Then GoTo did_not_work:
    Exit For

did_not_work:
    Next item
Set wb = Activeworkbook
wb.SaveAs Filename:=fn, Password:=""
wb.Close

End Sub