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