Excel使用VBA破解工作表/工作簿密码

   网上下载了工作簿,发现居然有密码!xxoo,既然放网上干嘛要加密码啊?!后来网上找到使用VBA破解工作表密码的方法,拿来分享。

  首先,尝试打开工作簿时,提示有密码:


  使用快捷键Ctrl+F11键,打开VBA编辑界面,点击“插入”菜单下的子菜单“模块”:


  在模块编辑器中输入以下代码:

  Option Explicit

  Public Sub AllInternalPasswords()

  Const DBLSPACE As String = vbNewLine & vbNewLine

  Const AUTHORS As String = DBLSPACE & vbNewLine & _

  "Adapted from Bob McCormick base code by" & _

  "Norman Harker and JE MCGImpsey"

  Const HEADER As String = "AllInternalPasswords User Message"

  Const VERSION As String = DBLSPACE

  Const REPBACK As String = DBLSPACE & "Please report failure " & _

  "to the microsoft.public.Excel.programming newsgroup."

  Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _

  "now be free of all password protection, so make sure you:" & _

  DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _

  DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _

  DBLSPACE & "Also, remember that the password was " & _

  "put there for a reason. Don't stuff up crucial formulas " & _

  "or data." & DBLSPACE & "Access and use of some data " & _

  "may be an offense. If in doubt, don't."

  Const MSGNOPWORDS1 As String = "There were no passwords on " & _

  "sheets, or workbook structure or windows." & AUTHORS & VERSION

  Const MSGNOPWORDS2 As String = "There was no protection to " & _

  "workbook structure or windows." & DBLSPACE & _

  "Proceeding to unprotect sheets." & AUTHORS & VERSION

  Const MSGTAKETIME As String = "After pressing OK button this " & _

  "will take some time." & DBLSPACE & "Amount of time " & _

  "depends on how many different passwords, the " & _

  "passwords, and your computer's specification." & DBLSPACE & _

  "Just be patient! Make me a coffee!" & AUTHORS & VERSION

  Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _

  "Structure or Windows Password set." & DBLSPACE & _

  "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _

  "Note it down for potential future use in other workbooks by " & _

  "the same person who set this password." & DBLSPACE & _

  "Now to check and clear other passwords." & AUTHORS & VERSION

  Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _

  "password set." & DBLSPACE & "The password found was: " & _

  DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _

  "future use in other workbooks by same person who " & _

  "set this password." & DBLSPACE & "Now to check and clear " & _

  "other passwords." & AUTHORS & VERSION

  Const MSGONLYONE As String = "Only structure / windows " & _

  "protected with the password that was just found." & _

  ALLCLEAR & AUTHORS & VERSION & REPBACK

  Dim w1 As Worksheet, w2 As Worksheet

  Dim i As Integer, j As Integer, k As Integer, l As Integer

  Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer

  Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer

  Dim PWord1 As String

  Dim ShTag As Boolean, WinTag As Boolean

  Application.ScreenUpdating = False

  With ActiveWorkbook

  WinTag = .ProtectStructure Or .ProtectWindows

  End With

  ShTag = False

  For Each w1 In Worksheets

  ShTag = ShTag Or w1.ProtectContents

  Next w1

  If Not ShTag And Not WinTag Then

  MsgBox MSGNOPWORDS1, vbInformation, HEADER

  Exit Sub

  End If

  MsgBox MSGTAKETIME, vbInformation, HEADER

  If Not WinTag Then

  MsgBox MSGNOPWORDS2, vbInformation, HEADER

  Else

  On Error Resume Next

  Do 'dummy do loop

  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

  With ActiveWorkbook

  .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 .ProtectStructure = False And _

  .ProtectWindows = False Then

  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _

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

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

  MsgBox Application.Substitute(MSGPWORDFOUND1, _

  "$$", PWord1), vbInformation, HEADER

  Exit Do 'Bypass all for...nexts

  End If

  End With

  Next: Next: Next: Next: Next: Next

  Next: Next: Next: Next: Next: Next

  Loop Until True

  On Error GoTo 0

  End If

  If WinTag And Not ShTag Then

  MsgBox MSGONLYONE, vbInformation, HEADER

  Exit Sub

  End If

  On Error Resume Next

  For Each w1 In Worksheets

  'Attempt clearance with PWord1

  w1.Unprotect PWord1

  Next w1

  On Error GoTo 0

  ShTag = False

  For Each w1 In Worksheets

  'Checks for all clear ShTag triggered to 1 if not.

  ShTag = ShTag Or w1.ProtectContents

  Next w1

  If ShTag Then

  For Each w1 In Worksheets

  With w1

  If .ProtectContents Then

  On Error Resume Next

  Do 'Dummy do loop

  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

  .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 Not .ProtectContents Then

  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _

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

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

  MsgBox Application.Substitute(MSGPWORDFOUND2, _

  "$$", PWord1), vbInformation, HEADER

  'leverage finding Pword by trying on other sheets

  For Each w2 In Worksheets

  w2.Unprotect PWord1

  Next w2

  Exit Do 'Bypass all for...nexts

  End If

  Next: Next: Next: Next: Next: Next

  Next: Next: Next: Next: Next: Next

  Loop Until True

  On Error GoTo 0

  End If

  End With

  Next w1

  End If

  MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER

  End Sub

  点击运行:


  破解过程需要几分钟,有几次对话框弹出,都是英文的,留意对话框中如下内容:


  标注部分即为密码。虽然不是原始密码,但是用这个密码照样可以打开工作簿的。

时间: 2024-10-28 20:47:26

Excel使用VBA破解工作表/工作簿密码的相关文章

巧用宏命令来为Excel工作表公式加密码

工作表中很多数据都是由公式计算生成的,那么如何让别人只看到计算的结果,而将使用的公式隐藏起来呢?今天我们就向大家介绍使用宏来解决这一问题. 一.创建宏 启动Excel,依次选择"工具"-"宏"-"录制新宏",在打开的窗口中输入宏的名称,并把"保存在"项设为"个人宏工作簿",单击"确定"按钮进入宏录制模式.此时我们可以在当前窗口中看到宏录制的工具栏,单击"停止录制"退出

Excel2007工作表设置权限密码

  ①启动Excel表格,单击左上角office按钮,然后点击另存为按钮. ②弹出另存为对话框,设置好保存路径之后,单击工具--常规选项. ③在常规选项界面,我们可以设置权限密码了. ④为了方便众多新手,我就详细的介绍一下各个选项的作用: 勾选"生成备份文件"在设置密码同时会备份当前设置密码的文件. 设置"打开权限密码",可以用设置的密码阅读Excel文件. 设置"修改权限密码",可以打开和修改Excel文件. 勾选"建议只读"

简单有效给隐藏的Excel工作表加个密码

想不想让Excel也像IE浏览器一样拥有一个主页?也就是每次启动Excel时,都会自动打开某个固定的工作簿.操作方法如下:将要显示的工作簿文件保存到"C:Program FilesMicrosoft OfficeOFFICE11XLStart"文件夹中.以后每次启动Excel时,都会自动打开这个工作簿. XLStart 如果是采用默认设置安装的Office,将文件保存到这个目录中才会起作用.否则需要找到Office的安装目录.路径中的"OFFICE11"是Offic

Excel工作表的设计策略

创建一个Excel工作表 (工作表:在 Excel 中用于存储和处理数据的主要文档.也称为电子表格.工作表由排列成行或列的单元格组成.工作表总是存储在工作簿中.)没有任何神秘之处可言,毕竟,这只是一些行和列而已.我们当然不想抑制您的创造性.即使是在开始编写电子表格的十多年后的今天,我们仍可以看到 ol 网格的绝妙新用途.但是,有几条可以让生活变得稍微容易一点的原则以及一些您需要小心的陷阱.这篇文章提出了您在装好数字设备准备开始构建自己的工作表之前应该问自己的一些问题. 哪些数据应该在行中,哪些应

在Excel工作表中选择单元格及其内容

在工作表 (工作表:在 Excel 中用于存储和处理数据的主要文档.也称为电子表格.工作表由排列成行或列的单元格组成.工作表总是存储在工作簿中.)中,您可以选择单元格.区域 (区域:工作表上的两个或多个单元格.区域中的单元格可以相邻或不相邻.).行或列.还可以使单元格处于编辑模式并选择该单元格的所有或部分内容. 您可以在 Microsoft Office Excel 表格中选择单元格和区域,就像在工作表中选择它们一样,但是选择表格的行和列不同于选择工作表的行和列. 注释 如果工作表处于受保护状态

Excel 2007工作表的插入与删除方法

默认情况下,MicrosoftOfficeExcel在一个工作簿中提供三个工作表(工作表:在Excel中用于存储和处理数据的主要文档.也称为电子表格.工作表由排列成行或列的单元格组成.工作表总是存储在工作簿中.),但是您可以根据需要插入其他工作表(和其他类型的工作表,如图表工作表.宏工作表或对话框工作表)或删除它们. 如果您能够访问自己创建的或OfficeOnline上提供的工作表模板(模板:创建后作为其他相似工作簿基础的工作簿.可以为工作簿和工作表创建模 板.工作簿的默认模板名为Book.xl

Excel,遗忘密码后如何撤销工作表保护密码

1.打开您需要撤销保护密码的Excel文件: 2.依次点击菜单栏上的工具---宏----录制新宏,输入宏名字如:ab: 3.停止录制(这样得到一个空宏): 4.依次点击菜单栏上的工具---宏----宏,选ab,点编辑按钮: 5.删除窗口中的所有字符(只有几个),替换为以下内容: Public Sub 工作表保护密码() Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE &

Excel工作薄与工作表的关系

刚学习Excel的网友,面对书籍上所讲的工作薄.工作表,难于理解这些概念! 下面,本文就给您详细介绍,Excel中的工作薄和工作表是啥关系,如何来理解工作薄与工作表的概念. 一.工作薄 首先我们看下图.注意看标题部分. "我的工作薄.xls",其扩展名为xls,指的是一个Excel文件.该Excel文件,指的就是一个工作薄. 简单的讲,一个Excel文件,也就是一个xls文件,指的就是一个工作薄. 二.工作表 现在,我们来看,如上图的Excel文件,里面存在Sheet1.Sheet2.

快速为Excel工作簿创建工作表目录的方法

我们经常把同类相关Excel工作表集中保存在同一文档中,以便于在各表格间进行引用.查看.当一个文档中的工作表达到一定数量时,要想找到需要的工作表就变得很麻烦了.此时若能建立一张"目录"工作表显示所有工作表的名称和链接,事情将会简单很多. 下面介绍一种可以快速为Excel工作簿创建工作表目录的方法. 定义名称 打开Excel 2007, 右击第一张工作表标签选择"重命名",把它重命名为"目录"工作表.选中B1单元格,切换到"公式"