怎么撤销工作薄保护的密码呀！

function2046

在做一个文件，发现设有保护 于是准备用VBA破解，可是在插入宏的时候出现了这个
请问这种情况怎么解决啊？

zhangliang123

下载一个OFFICE 办公软体解密器就可以了

function2046

zhangliang123 发表于 2014-12-9 21:55
下载一个OFFICE 办公软体解密器就可以了

谢谢，用了个宏也成功解决了

dyzx

function2046 发表于 2014-12-9 22:18
谢谢，用了个宏也成功解决了

请问怎样解决工作簿保护密码，用了什么个宏？多谢指教。

function2046

dyzx 发表于 2014-12-9 22:21
请问怎样解决工作簿保护密码，用了什么个宏？多谢指教。

清除VBA工程密码：Sub MoveProtect()
  Dim FileName As String
   FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xlsx）,*.xls;*.xlsx", , "VBA破解")
   If FileName = CStr(False) Then
      Exit Sub
   Else
      VBAPassword FileName, False   '  引用下面的自定义函数
   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 & ".abc"
     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 i
     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

加密excel_vba文件工程密码破解.zip (92.54 KB, 下载次数: 831)

2014-12-9 22:42 上传

点击文件名下载附件

原帖链接：http://blog.sina.com.cn/s/blog_3e1363140100hi2d.html
破解文件保护：

Sub PasswordBreaker()

Dim i As Integer, jAs Integer, k As Integer

Dim l As Integer, mAs Integer, n As Integer

Dim i1 As Integer, i2As Integer, i3 As Integer

Dim i4 As Integer, i5As Integer, i6 As Integer

On Error Resume Next

For i = 65 To 66: Forj = 65 To 66: For k = 65 To 66

For l = 65 To 66: Form = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66:For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66:For i6 = 65 To 66: For n = 32 To 126

ActiveSheet.UnprotectChr(i) & Chr(j) & Chr(k) & _

Chr(l) & Chr(m)& Chr(i1) & Chr(i2) & Chr(i3) & _

Chr(i4) & Chr(i5)& Chr(i6) & Chr(n)

IfActiveSheet.ProtectContents = False Then

MsgBox "Oneusable password is " & Chr(i) & Chr(j) & _

Chr(k) & Chr(l)& Chr(m) & Chr(i1) & Chr(i2) & _

Chr(i3) & Chr(i4)& Chr(i5) & Chr(i6) & Chr(n)

ActiveWorkbook.Sheets(1).Select

Range("a1").FormulaR1C1= Chr(i) & Chr(j) & _

Chr(k) & Chr(l)& Chr(m) & Chr(i1) & Chr(i2) & _

Chr(i3) & Chr(i4)& Chr(i5) & Chr(i6) & Chr(n)

Exit Sub

End If

Next: Next: Next:Next: Next: Next

Next: Next: Next:Next: Next: Next

End Sub

原帖链接：http://club.excelhome.net/thread-470401-1-1.html

不甘心的蜗牛

感谢分享。。。。

waybq

function2046 发表于 2014-12-9 22:44
清除VBA工程密码：Sub MoveProtect()
  Dim FileName As String
   FileName = Application.GetOpenFil ...

谢谢，有需要的时候试试看。

达州张先生

function2046 发表于 2014-12-9 22:44
清除VBA工程密码：Sub MoveProtect()
  Dim FileName As String
   FileName = Application.GetOpenFil ...

试了，没解出来，不知你是咋解出来的，谢谢

达州张先生

点击破解密码后，文件报错打字不开了，咋办？？请指教

1249994139

我也试了下，破解没有过成功，不知是何原因呢，请教下，谢谢！