EXCEL工作表和VBA密码去除法Word格式.docx

EXCEL工作表和VBA密码去除法Word格式.docx

《EXCEL工作表和VBA密码去除法Word格式.docx》由会员分享，可在线阅读，更多相关《EXCEL工作表和VBA密码去除法Word格式.docx（8页珍藏版）》请在冰豆网上搜索。

ConstZHENGLIAsString=DBLSPACE&

Neyo整理"

ConstALLCLEARAsString=DBLSPACE&

该工作簿中的工作表密码保护已全部解除!

!

&

DBLSPACE&

请记得另保存"

&

注意：

不要用在不当地方，要尊重他人的劳动成果！

ConstMSGNOPWORDS1AsString="

该文件工作表中没有加密"

ConstMSGNOPWORDS2AsString="

该文件工作表中没有加密2"

ConstMSGTAKETIMEAsString="

解密需花费一定时间,请耐心等候!

按确定开始破解!

ConstMSGPWORDFOUND1AsString="

密码重新组合为:

$$"

如果该文件工作表有不同密码,将搜索下一组密码并修改清除"

ConstMSGPWORDFOUND2AsString="

如果该文件工作表有不同密码,将搜索下一组密码并解除"

ConstMSGONLYONEAsString="

确保为唯一的?

Dimw1AsWorksheet,w2AsWorksheet

DimiAsInteger,jAsInteger,kAsInteger,lAsInteger

DimmAsInteger,nAsInteger,i1AsInteger,i2AsInteger

Dimi3AsInteger,i4AsInteger,i5AsInteger,i6AsInteger

DimPWord1AsString

DimShTagAsBoolean,WinTagAsBoolean

Application.ScreenUpdating=False

WithActiveWorkbook

WinTag=.ProtectStructureOr.ProtectWindows

EndWith

ShTag=False

ForEachw1InWorksheets

ShTag=ShTagOrw1.ProtectContents

Nextw1

IfNotShTagAndNotWinTagThen

MsgBoxMSGNOPWORDS1,vbInformation,HEADER

ExitSub

EndIf

MsgBoxMSGTAKETIME,vbInformation,HEADER

IfNotWinTagThen

Else

OnErrorResumeNext

Do'

dummydoloop

Fori=65To66:

Forj=65To66:

Fork=65To66

Forl=65To66:

Form=65To66:

Fori1=65To66

Fori2=65To66:

Fori3=65To66:

Fori4=65To66

Fori5=65To66:

Fori6=65To66:

Forn=32To126

.UnprotectChr（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=FalseAnd_

.ProtectWindows=FalseThen

PWord1=Chr（i）&

Chr（l）&

Chr（m）&

Chr（i3）&

Chr（i4）&

MsgBoxApplication.Substitute（MSGPWORDFOUND1,_

PWord1）,vbInformation,HEADER

ExitDo'

Bypassallfor...nexts

Next:

Next:

Next

LoopUntilTrue

OnErrorGoTo0

IfWinTagAndNotShTagThen

MsgBoxMSGONLYONE,vbInformation,HEADER

'

AttemptclearancewithPWord1

w1.UnprotectPWord1

ChecksforallclearShTagtriggeredto1ifnot.

IfShTagThen

Withw1

If.ProtectContentsThen

Dummydoloop

IfNot.ProtectContentsThen

MsgBoxApplication.Substitute（MSGPWORDFOUND2,_

leveragefindingPwordbytryingonothersheets

ForEachw2InWorksheets

w2.UnprotectPWord1

Nextw2

MsgBoxALLCLEAR&

AUTHORS&

VERSION&

REPBACK&

ZHENGLI,vbInformation,HEADER

EndSub

二、VBA密码破解forExcel2003

在空白excel文档vba里面插入模块，运行此模块

OptionExplicit

ConstLANG_ENGLISHAsInteger=9

TypeCommandLineInfo

NameAsString

ValueAsString

StartPosAsLong

EndType

Submain（）

DimfNameAsString

fName=Application.GetOpenFilename（"

Excel文件（xls;

xla）,*.xls;

*.xla"

,"

选择要破解的EXCEL2003包含VBA密码的文件"

）

IffName="

False"

ThenExitSub

DimfNewNameAsString

fNewName=MoveProtect（fName）

IfLen（fNewName）Then

IfMsgBox（"

转换完成,另存为：

vbLf&

fNewName&

要打开吗？

vbQuestion+vbYesNo,"

完成"

）=vbYesThenWorkbooks.OpenfNewName

Else

MsgBox"

未发现VBAProject有密码特征字符串"

vbInformation,"

提示"

EndIf

PrivateFunctionMoveProtect（fNameAsString）AsString

DimmyExcelFileDataAsString

DimmyCommandLinesInfo（）AsCommandLineInfo

myExcelFileData=GetFileData（fName）

IfSearchSpecificCommandInfo（myExcelFileData,myCommandLinesInfo）Then

MoveProtect=Write2File（Left（fName,Len（fName）-4）&

_覆盖VBA密码.xls"

CoverData（myExcelFileData,myCommandLinesInfo））

EndFunction

PrivateFunctionGetFileData（fNameAsString）AsString