excel提取指定文件夹文件名代码

Sub getpath()

Range("A2:C1000").ClearContents '清空A2：C1000列

On Error Resume Next

Dim shell As Variant

Set shell = CreateObject("Shell.Application")

Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "") '获取文件夹路径地址

Set shell = Nothing

If filePath Is Nothing Then '检测是否获得有效路径，如取消直接跳出程序

Exit Sub

Else

gg = filePath.Items.Item.Path

End If

Set obj = CreateObject("Scripting.FileSystemObject") '定义变量

Set fld = obj.getfolder(gg) '获取路径

For Each ff In fld.Files '遍历文件夹里文件

m = m + 1

Cells(m + 1, 1) = ff.DateCreated

Cells(m + 1, 2) = https://www.360docs.net/doc/a84604653.html,

End Sub

破解excel保护密码的宏代码

Option Explicit Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) ' Reveals hashed passwords NOT original passwords 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 & "Version 1.1.1 2003-Apr-04" 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: " & _

EXCEL密码保护破解2010

EXCEL密码保护破解方法: 1\打开文件 2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧) 6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!! 代码如下： Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1)

' Reveals hashed passwords NOT original passwords 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 & "Version 1.1.1 2003-Apr-04" 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

破解excel密码宏程序代码

1.将你要破解的Excel文件关闭，切记一定要关闭呀！然后新建一个Excel文件 2.打开新建的这个Excel，按下alt+F11，打开vb界面，新建一个模块，如图所示

3.将代码复制到这个模块中，代码如下： Private Sub VBAPassword() '你要解保护的Excel文件路径 Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解") If Dir(Filename) = "" Then MsgBox "没找到相关文件,清重新设置。" Exit Sub 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 If GetData = "CMG=""" Then CMGs = i If GetData = "[Host" Then DPBo = i - 2: Exit For Next If CMGs = 0 Then MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示" Exit Sub End If Dim St As String * 2 Dim s20 As String * 1 '取得一个0D0A十六进制字串 Get #1, CMGs - 2, St '取得一个20十六制字串 Get #1, DPBo + 16, s20

如何破解EXCEL工作表保护密码忘记密码怎么办

如何破解EXCEL工作表保护密码忘记密码怎么办 1.新建一个EXCEL工作表，而后点击另存为，讲表格保存为启用宏的工作表 2.一次点击开发工具---录制新宏，在弹出的对话框内修改宏名称而后确定 3.依次点击开发工具----停止录制宏，宏录制完成

4.依次点击开发工具，---宏----在弹出的对话框找到我们刚才录制的宏名称而后进入 VBA界面 5.在VBA界面，全选里面的代码，而后删除，讲里面的代码全部删除完

6.代码复制到VBA编辑窗口内 Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) ' Reveals hashed passwords NOT original passwords 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 & "Version 1.1.1 2003-Apr-04" 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."

excel文件的解密方法

excel文件忘记密码后的解密方法 excel文件密码的设置有2种，一种是写保护，另外一种是打开保护。对应不同的保护措施，应该用不同的解密方法。一：这是写保护的破解：方法: 1\打开文件 2\工具---宏----录制新宏---输入名字如:aa 3\停止录制(这样得到一个空宏) 4\工具---宏----宏,选aa,点编辑按钮 5\删除窗口中的所有字符(只有几个),替换为下面的内容:(复制吧) 6\关闭编辑窗口 7\工具---宏-----宏,选AllInternalPasswords,运行,确定两次,等2分钟,再确定.OK,没有密码了!!代码如下：Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) ' Reveals hashed passwords NOT original passwords 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 & "Version 1.1.1 2003-Apr-04" 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" & _