


 

 

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
采用递归算法删除带有多级子目录的目录
