excel vba删除所有空白文件夹

我们为了整理文件，我们都会建立文件夹。随着时间的推移，很多文件夹的文件可能被移出，有很多空白的文件夹如何用Excel vba删除空白的文件夹呢？我们用excel vba 创建自定义的函数
删除空白文件夹的函数：SubDelEmtyDir(ByValstrPathAsString)
DimfsoAsNewFileSystemObject
DimstrDirNameAsString,LastDirAsString
DimstrFldAsString,fldAsFolder
IfstrPath="Fase"OrstrPath=""ThenExitSub
IfRight(strPath,1)""ThenstrPath=strPath&""
strDirName=Dir(strPath,vbDirectory) '取得子文件夹
DoWhilestrDirName""
IfstrDirName"."AndstrDirName".."Then
If(GetAttr(strPath&strDirName)AndvbDirectory)=vbDirectoryThen
LastDir=strDirName
Setfld=fso.GetFolder(strPath&strDirName)
Iffld.Size=0Then
fld.Delete
strFld=Left(strPath&strDirName,InStrRev(strPath$&strDirName,"")-1)
CallDelEmtyDir(strFld)
Else
CallDelEmtyDir(strPath&strDirName)
EndIf
strDirName=Dir(strPath,vbDirectory)
DoUntilstrDirName=LastDirOrstrDirName=""
strDirName=Dir
Loop
IfstrDirName=""ThenExitDo
EndIf
strDirName=Dir
EndIf
Loop
Setfso=Nothing
EndSub
运行函数，填写删除的文件夹的路径Sub删除空文件夹()
DimstrPathAsString
strPath=Application.InputBox("请输入文件夹名称","输入文件夹名称",ThisWorkbook.Path,2)
IfstrPath="Fase"OrstrPath=""ThenExitSub
CallDelEmtyDir(strPath)
EndSub
运行效果图：

1510996268112734.png

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