一个朋友自己对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

最终,密码成功找回.
说明一下,提供的线索非常重要,如果不提供线索的话,是需要耗时太久的,往往没有耐心等到结果.