excel vba删除所有空白文件夹

我们为了整理文件，我们都会建立文件夹。随着时间的推移，很多文件夹的文件可能被移出，有很多空白的文件夹

如何用Excel vba删除空白的文件夹呢？我们用excel vba 创建自定义的函数

删除空白文件夹的函数：

Sub DelEmtyDir(ByVal strPath As String)
    Dim fso As New FileSystemObject
    Dim strDirName As String, LastDir As String
    Dim strFld As String, fld As Folder
    If strPath = "Fase" Or strPath = "" Then Exit Sub
    If Right(strPath, 1) <> "" Then strPath = strPath & ""
    strDirName = Dir(strPath, vbDirectory) '取得子文件夹
    Do While strDirName <> ""
        If strDirName <> "." And strDirName <> ".." Then
            If (GetAttr(strPath & strDirName) And vbDirectory) = vbDirectory Then
                LastDir = strDirName
                Set fld = fso.GetFolder(strPath & strDirName)
                If fld.Size = 0 Then
                    fld.Delete
                    strFld = Left(strPath & strDirName, InStrRev(strPath$ & strDirName, "") - 1)
                    Call DelEmtyDir(strFld)
                Else
                    Call DelEmtyDir(strPath & strDirName)
                End If
                strDirName = Dir(strPath, vbDirectory)
                Do Until strDirName = LastDir Or strDirName = ""
                    strDirName = Dir
                Loop
                If strDirName = "" Then Exit Do
            End If
            strDirName = Dir
        End If
    Loop
    Set fso = Nothing
End Sub

运行函数，填写删除的文件夹的路径

Sub 删除空文件夹()
    Dim strPath As String
    strPath = Application.InputBox("请输入文件夹名称", "输入文件夹名称", ThisWorkbook.Path, 2)
    If strPath = "Fase" Or strPath = "" Then Exit Sub
    Call DelEmtyDir(strPath)
End Sub

运行效果图：

参考至：小智雅汇(头条号)