Option Explicit

Private Sub Command1_Click()

Dim strPathName As String

strPathName = ""

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

If strPathName = "" Then Exit Sub

On Error GoTo ErrorHandle

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

RecurseTree strPathName

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

Exit Sub

ErrorHandle:

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

End Sub

Sub RecurseTree(CurrPath As String)

Dim sFileName As String

Dim newPath As String

Dim sPath As String

Static oldPath As String

sPath = CurrPath & "\"

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

Do While sFileName <> ""

If sFileName <> "." And sFileName <> ".." Then

If GetAttr(sPath & sFileName) And vbDirectory Then '如果是目录和文件夹

newPath = sPath & sFileName

RecurseTree newPath

sFileName = Dir(sPath, 31)

Else

SetAttr sPath & sFileName, vbNormal

Kill (sPath & sFileName)

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

sFileName = Dir

End If

Else

sFileName = Dir

End If

DoEvents

Loop

SetAttr CurrPath, vbNormal

RmDir CurrPath

Label1.Caption = CurrPath

End Sub