VBA to Break Woorkbook rencrypted password

[Andrei]

Hello,

I am trying to make a code that will break the workbook's password. I used one code to break the worksheet protection password, but i can't manage to make it working also for protection at the level of the workbook. (password requested before the workbook is opened).

My idea is to put the code in another workbook, to loop through all possible passwords and try to open the encrypted workbook with each password. If the password is incorrect we will have an error and in this case we will use on error resume next statement and go to the next password, until one password will be correct. All things seem easy, but when the code finds the correct password, it opens the workbook, but then it closes it and goes to next password I can't find a way to say: when you found the correct password, just Exit sub and keep the encrypted workbook opened...

For example in the attached files, the file named "test2.xlsx" is the encrypted file, with password "AAAAAAAAAAA!" (the second password from the loop). The code (loop) is in the file "Password breaker". Run the macro "mcro2", the first password "AAAAAAAAAAA" appears in the MSGBOX, is incorrect, so the loop goes forward, the second password is the correct one, the file "test2" opens, but when we hit "OK" in the MSGBOX it closes and the macro goes to next password.. In this step it should just exit sub and mentain the "test2" file open..

PS: to test it you need to change the file location "C:\Users\USER\Desktop\" with the location where you downloaded the file...

How can we fix this problem ? I think that if we manage to fix it will help also other users..

CODE:

Dim wBook As Workbook
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
  Dim password As String
  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

  
On Error Resume Next

Set wBook = Workbooks("test2.xls")

password = Chr(i) & Chr(j) & Chr(k) & _
      Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
      Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    
Workbooks.Open Filename:="C:\Users\USER\Desktop\test2.xlsx", password:=password


If wBook = "" Then 'Not open, do nothing

MsgBox Chr(i) & Chr(j) & _
          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
          Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

    wBook.Activate

    'On Error GoTo 0

Else 'It is open
  
    wBook.Activate

    'Set wBook = Nothing
    On Error GoTo 0
  
    'wBook.Sheet1.Range("A1").Select

    ' 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)
  'ActiveWorkbook.Sheets(1).Select
  'Range("a1").FormulaR1C1 = 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

  On Error GoTo 0

End Sub

Thanks a lot,
Andrei

 

[Andrei]

Hi,

I modified the code and for example it works for the password: AAAAAAAAAAB5 that i set for "test2.xlsx" new file attached. It opens the file in aprox 7-10 seconds

But i tried it also for other password, ex: "andrei" and it took too long.. i stopped the macro, so i don't know if it works for all passwords if i let it long time to run.. My question is, should it work for all passwords or only for 12 character passwords ? (for worksheet unprotect the code works very fast for any password)

don't forget to modify the file path in the bellow code before testing it :

Sub mcro2()

'Dim wBook As Workbook
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
  Dim password As String
  '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


On Error Resume Next

password = Chr(i) & Chr(j) & Chr(k) & _
  Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
  Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Workbooks.Open Filename:="C:\Users\USER\Desktop\test2.xlsx", password:=password

If Err.Number = 0 Then

MsgBox 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

 

[Andrei]

I read some more info and it will not work like this... This code was made just for removing worksheet protection.. I can't understand how it works, why it loops for first 11 characters just from 65 to 66 (A and B) and it works for all kind of password... but anyway...

Do you have any ideea how can we make the code loop through all posibilities of passwords for example with minimum one character and maximum 10 ? (To search like this: A,AA,AAA.....AB,ABB,ABBB.....AC,ACC,ACCC.... AD..... etc) and when it finds the correct password it will open the file.. or any other ideas ?