使用VBA Excel电子表格密码破解(Excel spreadsheet password cra

我试着写一个VBA类似于我用来破解Excel工作表的密码编码密码破解代码，但我不知道如果我正确或不这样做-当我尝试这个代码就提示我输入密码，但没有设置密码输入到文本输入框。

请建议我在做什么错。

谢谢

Sub testmacro()
Dim password
Dim a, b, c, d, e, f, g, h, i, j, k, l
SendKeys "^r"
SendKeys "{PGUP}"

For a = 65 To 66
    For b = 65 To 66
        For c = 65 To 66
            For d = 65 To 66
                For e = 65 To 66
                    For f = 65 To 66
                        For g = 65 To 66
                            For h = 65 To 66
                                For i = 65 To 66
                                    For j = 0 To 255
                                        password = Chr(a) & Chr(b) & Chr(c) & Chr(d) & Chr(e) & Chr(f) & Chr(g) & Chr(h) & Chr(i) & Chr(j)
                                        SendKeys "{Enter}", True
                                        MsgBox password
                                        SendKeys password, True
                                        SendKeys "{Enter}", True

                                        On Error GoTo 200
                                        MsgBox password
                                        GoTo 300
200                                         password = ""

                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next
300 MsgBox "exited"
End Sub

Answer 1:

你的代码没有被正确执行的原因是因为你试图在密码保护EXECEL文件，该文件是不允许执行的宏。 这是由于宏不会在Excel工作簿，直到输入密码执行的事实 - 输入密码从而提示，然后才能执行宏代码。

该SO文章解释了这个问题，以及，用更详细： Excel的VBA -自动输入密码

编辑

对于2003

---

如果您尝试访问的工作簿 ，不工作表，有各种各样的2003年及更早版本的方式。 快速perusual后，这BlogSpot的代码示例入门似乎有一个工作版本不保护一个2003工作。

此外，在一个相关的说明，如果你退一步，甚至进一步，并试图解开VBA项目，该SO文章似乎充分地解决这一问题。

对于2007年

---

如果你只是想“强力”解除对某个客户端的工作簿，名为杰森先生已经概述了在他的博客中这样一个过程 。

---

Answer 2:

它看起来像你试图解开一个工作簿中的密码才能打开它？

你绝对不应该使用的是的SendKeys。 您应该只曾经使用的SendKeys作为最后的手段。

为了避免冲突，将代码放在另一个工作簿和替代的SendKeys使用：

Workbooks.Open Filename:="C:\passtest.xls", Password:=password

如果工作簿已经打开和保护工作簿或表或图表的使用：

[object].Unprotect password

Wherew [对象]是您要取消保护什么的参考。

如果你想解锁VBA代码，请按照JimmyPena评论

这里的一个附图为使用类似代码到您的用于解锁所述活性片某人。

Answer 3:

我成功地执行在Excel 2013年这个脚本在Excel 2003中创建的密码保护的工作簿。

遵循以下步骤：

开发者 - >录制宏（起一个名字，然后做一些点击）

宏 - >带你编辑创建的宏。

替换下面全功能的宏：

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 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.Unprotect Chr(i) & Chr(j) & Chr(k) & _
        Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable 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)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

Answer 4:

也许有一定的帮助？

Option Explicit

Const PWDMaxLength = 9
Const MaxTimeInSeconds = 600    ' 10 Minutes
Const PWDWindowName = "Password"
Const TargetFile = "D:\Dropbox\Excel stuff\crack\test.xls"
Const LowerCase = "abcdefghijklmnopqrstuvwxyzæøå"
Const UpperCase = "ABCDEFGHIJKLMNOPQRSTUVWXYZÆØÅ"
Const SpesChars = "+-*@#%=?!_;./"
Const Digits = "0123456789"
Dim CrackAttempt As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long


Sub BFOpen()
On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open Filename:=TargetFile
Application.DisplayAlerts = True
On Error GoTo 0
End Sub


Sub BFCrack()
'On Error Resume Next
Dim lSta, lCur As Long, test, str, PWD As String
lSta = GetTickCount()
PWD = LowerCase & UpperCase & SpesChars & Digits
CrackAttempt = 1
test = InputBox("Insert test string for brutforce if wanted" & vbCrLf & "not more than 5 characters...", "input")
SendKeys "%{TAB}", 100
Do While str <> test Or FindWindow(vbNullString, PWDWindowName) And (Len(str) < PWDMaxLength <> 0 And (lCur / 1000) < MaxTimeInSeconds)
  lCur = (GetTickCount() - lSta)
  If lCur Mod 250 = 0 Then Application.StatusBar = str & " " & CrackAttempt & " " & lCur
  str = GBFS(PWD, CrackAttempt)
  If test = "" Then SendKeys str & "{ENTER}", 1000
  CrackAttempt = CrackAttempt + 1
Loop
Application.StatusBar = False
If str <> "" Then MsgBox str & " found in " & CStr((GetTickCount() - lSta) / 1000) & " seconds after " & CrackAttempt & " attempts", vbOKOnly + vbInformation, "Result"
On Error GoTo 0
End Sub


Function GBFS(ByVal inp As String, ByVal att As Long) As String
  Dim Base, cal As Integer, rmi, res As Long
  Base = Len(inp)
  If Base < 2 Then Exit Function
  rmi = att
  Do While rmi > 0
    res = Int(rmi / Base)
    cal = rmi - (res * Base)
    If cal = 0 Then
      cal = Base
      res = res - 1
    End If
    GBFS = Mid(inp, cal, 1) & GBFS
    rmi = res
  Loop
End Function

文章来源: Excel spreadsheet password cracking using VBA