VBA Excle 取消保護

方法1

使用VBA 腳本

Alt +F11
貼上語法執行:

Private Sub VBAPassword()  'The path to the Excel file you want to unprotect
Filename = Application.GetOpenFilename("Excel file (* .xls & * .xla & * .xlt), *. Xls; *. Xla; *. Xlt", , "VBA crack")
If Dir(Filename) = "" Then
MsgBox "No related files found, please reset."
Exit Sub
Else
FileCopy Filename, Filename & ".bak" 'Backup file.
End If
Dim GetData As String * 5
Open Filename For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get #1, i, GetData
If GetData = "CMG=""" Then CMGs = i
If GetData = "[Host" Then DPBo = i - 2: Exit For
Next
If CMGs = 0 Then
MsgBox "Please set a protection password for VBA encoding ...", 32, "Tip"
Exit Sub
End If

Dim St As String * 2
Dim s20 As String * 1
'Get a 0D0A hexadecimal string
Get #1, CMGs - 2, St
'Get a 20 sixteen string
Get #1, DPBo + 16, s20
'Replace encrypted part code
For i = CMGs To DPBo Step 2
Put #1, i, St
Next
'Add unmatched symbol
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End If
MsgBox "File decryption succeeded ...", 32, "Tip"
Close #1
End Sub

Alt +F11
貼上語法執行:

方法2

Sub asd()
newFileName = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".") - 1)

ActiveWorkbook.SaveAs Filename:=newFileName & "_new" & ".csv" & Extension, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=newFileName & "_new" & ".xls" & Extension, FileFormat:=xlExcel8

End Sub

開啟xls檔

方法3

Excel 儲存成.csv 視窗不要關再次儲存成(Excel 97-2003).xls
這時會發現可以取消保護密碼，不用輸入任何值