用VBA破解Excel密码

'1、工作表无法编辑，撤销保护
Sub sheet_unprotect()
ActiveSheet.Protect AllowFiltering:=True
ActiveSheet.Unprotect
End Sub

'2、工作簿结构无法更改，撤销保护（已测试成功）

Sub sheet_visible()
ActiveWorkbook.Sheets.Copy
For Each sh In ActiveWorkbook.Sheets
sh.Visible = True
Next
End Sub

'3、工作表加密，打开需要密码，破解
'先只读打开

Sub crack()
Dim i As Long
Dim FileName As String
Application.ScreenUpdating = False
i = 1
FileName = Application.GetOpenFilename("Excel 文件（*.xls & *.xlsx),*.xls;*.xlsx", , "VBA破解")
FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
line2:
On eror GoTo line1
Do While True
Workbooks.Open FileName, , , , i
MsgBox "password is " & i
Exit Sub
Loop
line1:
i = i + 1
Resume line2
Application.ScreenUpdating = True

End Sub