天天看點

vba或xla檔案 密碼移除(from internet)

0.先備份 你”已忘記密碼

vba或xla檔案 密碼移除(from internet)

“的xla宏檔案,或excel檔案

1. 使用UltreEdit之類的十六進制編輯程式打開.XLS檔案,在文本模式下查找“[Host Extender Info]”

vba或xla檔案 密碼移除(from internet)
vba或xla檔案 密碼移除(from internet)
vba或xla檔案 密碼移除(from internet)

2. 剛才定位的位置切換到十六進制模式,

  将前面的“DBP="XXXXXXX...”的DBP關鍵字改成CBP,

 将“GC="XXXXXXX...”的GC關鍵字改成CC,(其它亦可)

vba或xla檔案 密碼移除(from internet)
vba或xla檔案 密碼移除(from internet)

使Excel不能識别此二項!存盤即可!!!

  用Excel打開此檔案,忽略錯誤提示,

vba或xla檔案 密碼移除(from internet)
vba或xla檔案 密碼移除(from internet)
vba或xla檔案 密碼移除(from internet)

進入VBA編輯器,嘿嘿,密碼沒有了!

做一次存盤操作即可修複錯誤提示。   

另網絡上給出的一段vba執行方法解除密碼: 測試不成功,衆位可以參考改進代碼。

'移除VBA編碼保護
Sub MoveProtect()
Dim FileName As String
           
'使用者選擇要破解的檔案
FileName = Application.GetOpenFilename("Excel檔案(*.xls & *.xla),*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
     Exit Sub
Else
     VBAPassword FileName, False
End If
End Sub

'設定VBA編碼保護
Sub SetProtect()
Dim FileName As String
FileName = Application.GetOpenFilename("Excel檔案(*.xls & *.xla),*.xls;*.xla", , "VBA破解")
If FileName = CStr(False) Then
     Exit Sub
Else
     VBAPassword FileName, True
End If
End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
    If Dir(FileName) = "" Then
       Exit Function
    Else
       FileCopy FileName, FileName & ".bak"  ' 備份原檔案
    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    '讀取檔案内容到GetData
        If GetData = "CMG=""" Then CMGs = i
        If GetData = "[Host" Then DPBo = i - 2: Exit For
    Next
    
    If CMGs = 0 Then
       MsgBox "請先對VBA編碼設定一個保護密碼...", 32, "提示"
       Exit Function
    End If
    
    If Protect = False Then
       Dim St As String * 2
       Dim s20 As String * 1
       
       '取得一個0D0A十六進制字串
       Get #1, CMGs - 2, St
    
       '取得一個20十六制字串
       Get #1, DPBo + 16, s20
    
       '替換加密部份機碼
       For i = CMGs To DPBo Step 2
           Put #1, i, St
       Next
       
       '加入不配對符号
       If (DPBo - CMGs) Mod 2 <> 0 Then
          Put #1, DPBo + 1, s20
       End If
       MsgBox "檔案解密成功......", 32, "提示"
    Else
       Dim MMs As String * 5
       MMs = "DPB="""
       Put #1, CMGs, MMs
       MsgBox "對檔案特殊加密成功......", 32, "提示"
    End If
    Close #1
End Function