Excel密碼忘記了,遍歷法找回密碼

一個朋友自己對EXCEL的一個文件設定了密碼,結果搞忘了.
但是提供的線索是: 密碼是由123456後面加ABCD四個大寫字母組合的四位字母組合,密碼長度10位.

所以使用
Sub crack()
Dim i0 As Long
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim s0 As String
Dim FileName As String
Application.ScreenUpdating = False
i0 = 0
i1 = Int(i0 / 64)
i2 = Int(i0 / 16) - i1 * 4
i3 = Int(i0 / 4) - i2 * 4 - i1 * 16
i4 = Int(i0 / 1) - i3 * 4 - i2 * 16 - i1 * 64
'FileName = Application.GetOpenFilename("Excel檔案（*.xls & *.xlsx）,*.xls;*.xlsx", , "VBA破解")
'FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
FileName = Right("C:\dingliao.xls", Len("C:\dingliao.xls") - InStrRev("C:\dingliao.xls", "\"))
line2:
On Error GoTo line1
Do While i0 < 256 'True
i1 = Int(i0 / 64)
i2 = Int(i0 / 16) - i1 * 4
i3 = Int(i0 / 4) - i2 * 4 - i1 * 16
i4 = Int(i0 / 1) - i3 * 4 - i2 * 16 - i1 * 64
s0 = "123456" & Chr(i1 + 65) & Chr(i2 + 65) & Chr(i3 + 65) & Chr(i4 + 65)
Workbooks.Open FileName, , , , s0
Workbooks(FileName).Close 0
MsgBox "Password is " & "060169" & Chr(i1 + 97) & Chr(i2 + 97) & Chr(i3 + 97) & Chr(i4 + 97)
Exit Sub
Loop
line1:
i0 = i0 + 1
If i0 >= 257 Then
  Exit Sub
End If
Resume line2
Application.ScreenUpdating = True
End Sub

最終,密碼成功找回.
說明一下,提供的線索非常重要,如果不提供線索的話,是需要耗時太久的,往往沒有耐心等到結果.

來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/29512902/viewspace-1169691/，如需轉載，請註明出處，否則將追究法律責任。