VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 采用递归算法删除带有多级子目录的目录
发表评论(0)作者:, 平台:, 阅读:9811, 日期:2000-03-29
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