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