mod_retree.bas

家谱管理软件,树形控件操作,可保存文本和图片,查找快捷

Attribute VB_Name = "Mod_Retree"
Option Explicit

'用递归算法删除带有多级子目录的目录

Sub RecurseTree(CurrPath As String)

    On Error GoTo ErrorHandle
    SetAttr CurrPath, vbNormal '此行主要是为了检查文件夹名称的有效性
    
    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)
                sFileName = Dir
            End If
        Else
            sFileName = Dir
        End If
        DoEvents
    Loop
    SetAttr CurrPath, vbNormal
    RmDir CurrPath
    
ErrorHandle:

End Sub