OptionExplicit

　　PrivateSubCommand1_Click()

　　DimstrPathNameAsString

　　strPathName=""

　　strPathName=InputBox("請輸入需要刪除的文件夾名稱∶","刪除文件夾")

　　IfstrPathName=""ThenExitSub　　

　　OnErrorGoToErrorHandle

　　SetAttrstrPathName,vbNormal'此行主要是為了檢查文件夾名稱的有效性

　　RecurseTreestrPathName

　　Label1.Caption="文件夾"&strPathName&"已經(jīng)刪除！"

　　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