[VBA]將某目錄內的第N層的檔案及子目錄都刪除掉

[VBA]將某目錄內的第N層的檔案及子目錄都刪除掉

以下說明如何將F:\SCRIPT目錄下第2層目錄內(F:\SCRIPT\FIRSTFLODER)的檔案及子目錄都刪除掉。

image

程式如下,

Dim FSO, agoDays, CreatedDate, delFolder    ' 宣告變數
'要刪除目錄層級
Const KillPathCount = 2
Private Sub Command1_Click()
    '要刪除的主目錄
    delFolder = "F:\SCRIPT"
    ' 建立檔案系統物件(File System Object)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ' 呼叫刪除資料夾的子程序
    DelFilesInFolder FSO.GetFolder(delFolder)
    MsgBox "OK"
End Sub

'取得Path的層級
Function GetPathLevel(path)
    Dim result
    result = 0
    Dim pos
    pos = 0
    Do
        pos = InStr(pos + 1, path, "\")
        If pos > 0 Then
            result = result + 1
        End If
    Loop Until pos = 0
    GetPathLevel = result
End Function

'要刪除某個目錄下某一層的檔案及目錄
Sub DelFilesInFolder(folder)
    Dim subFolder     ' 宣告變數
    ' 找出目前所在目錄內所有的目錄
    For Each subFolder In folder.SubFolders
        Dim folderPath
        folderPath = subFolder.path
        '如果目錄大於KillPathCount層就刪掉
        Dim pathLevel
        pathLevel = GetPathLevel(folderPath)
        If pathLevel > KillPathCount Then
            '先把目錄的檔案刪除
            '如果下面還有subFolder要先刪掉
            If subFolder.SubFolders.Count > 0 Then
                Call DelFilesInFolder(subFolder)
            End If
            If FSO.FolderExists(folderPath) Then
                Call FSO.DeleteFolder(folderPath)
            End If
            
        ElseIf pathLevel = KillPathCount Then
            '要刪除檔案
             FSO.DeleteFile subFolder & "\*.*"
             Call DelFilesInFolder(subFolder)
        Else
            Call DelFilesInFolder(subFolder)
        End If
    Next
End Sub

Hi, 

亂馬客Blog已移到了 「亂馬客​ : Re:從零開始的軟體開發生活

請大家繼續支持 ^_^