删除指定文件夹及其子文件夹中的所有文件，但保留文件夹

fanjy

发布于 2024-04-19 14:29:50

4610

发布于 2024-04-19 14:29:50

文章被收录于专栏：完美Excel

excelperfect

标签：VBA

经常要整理电脑中的文件，特别是每当要自查电脑文件时。每次都是将一个一个文件夹打开，将其中的文件全部删除，但要保留文件夹，以便于后面再陆续存放新的文件。

手动操作起来每繁琐，特别是当文件夹及其子文件夹很多且里面的文件也较多时。

其实，这样的工作使用VBA来很好解决。

下面的程序会删除指定文件夹中的所有文件，包括其子文件夹中的文件，但会保留文件夹，即保留文件夹框架，以便再往里面存放新文件。

Sub KillFiles(strPath As String, Optional blnRecursive As Boolean)
 ' 本过程返回目录中的所有文件到Dictionary对象中.
 ' 如果递归调用则同时返回子文件夹中的所有文件.
 Dim fsoSysObj      As Scripting.FileSystemObject
 Dim fdrFolder      As Scripting.Folder
 Dim fdrSubFolder   As Scripting.Folder
 Dim filFile        As Scripting.file
 ' 返回新的FileSystemObject.
 Set fsoSysObj = New Scripting.FileSystemObject
 On Error Resume Next
 ' 获取文件夹.
 Set fdrFolder = fsoSysObj.GetFolder(strPath)
 If Err <> 0 Then
   ' 不正确的路径.
   GoTo GetFiles_End
 End If
 On Error GoTo 0
 ' 遍历Files集合,添加到字典.
 For Each filFile In fdrFolder.Files
   Kill filFile
 Next filFile
 ' 如果Recursive标志为真,则递归调用.
 If blnRecursive Then
   For Each fdrSubFolder In fdrFolder.Subfolders
     KillFiles fdrSubFolder.Path, True
   Next fdrSubFolder
 End If
 
GetFiles_End:
 Exit Sub
End Sub

' 测试代码：
Sub test()
  KillFiles "C:\Users\excelperfect\Desktop\1", True
End Sub

可以将其中的文件夹路径更换为实际文件夹路径。

注意，在使用程序前，需要添加对Microsoft Scripting Runtime对象库的引用。具体操作为，在VBE中，单击菜单“工具——引用”，在“引用”对话框中，找到“Microsoft Scripting Runtime”并勾选其前面的复选框，如下图1所示。