OptionExplicit

PrivateSubCommand1_Click()

DimstrPathNameAsString

strPathName=""

strPathName=InputBox("请输入需要删除的文件夹名称∶","删除文件夹")

IfstrPathName=""ThenExitSub

OnErrorGoToErrorHandle

SetAttrstrPathName,vbNormal'此行主要是为了检查文件夹名称的有效性

RecurseTreestrPathName

Label1.Caption="文件夹"&strPathName&"已经删除！"

ExitSub

ErrorHandle:

MsgBox"无效的文件夹名称:"&strPathName

EndSub

SubRecurseTree(CurrPathAsString)

DimsFileNameAsString

DimnewPathAsString

DimsPathAsString

StaticoldPathAsString

sPath=CurrPath&"\"

sFileName=Dir(sPath,31)'31的含义∶31=vbNormal vbReadOnly vbHidden vbSystem vbVolume vbDirectory

DoWhilesFileName<>""

IfsFileName<>"."AndsFileName<>".."Then

IfGetAttr(sPath&sFileName)AndvbDirectoryThen'如果是目录和文件夹

newPath=sPath&sFileName

RecurseTreenewPath

sFileName=Dir(sPath,31)

Else

SetAttrsPath&sFileName,vbNormal

Kill(sPath&sFileName)

Label1.Caption=sPath&sFileName'显示删除过程

sFileName=Dir

EndIf

Else

sFileName=Dir

EndIf

DoEvents

Loop

SetAttrCurrPath,vbNormal

RmDirCurrPath

Label1.Caption=CurrPath

EndSub