Question

我开发了一个代码，该代码循环遍历在Excel电子表格中找到的文件和文件夹的名称，在文件夹中找到它们并将其删除。

问题在于，有些文件和文件夹没有显示在电子表格中，但仍需要删除。我的目标是拥有更多的可用空间。

有人建议我将文件夹列表复制到另一列，匹配文件名，然后删除不匹配的文件名。

不过，我更喜欢自动化。有什么建议吗？

谢谢！

代码：

Sub DeleteSpecificFilesAndFolders()

'This module deletes Extracted Files folders, Flat Files folders and Final Flat Files (.txt format)

Const path = "C:\Users\N\Desktop\Kill_function_test\Test folder for deleting\"

Dim r As Range
Dim r2 As Range
Dim folderpath As String
Dim folderpath_1 As String

Dim fso As FileSystemObject
Set fso = New Scripting.FileSystemObject



Set r2 = Cells(2, 1)

Do Until r2 = ""


folderpath = path & r2 & "\" & "Extracted Files"


'Checks if the folder exists and then deletes it.
If fso.FolderExists(folderpath) Then

    fso.DeleteFolder (folderpath)

End If


'Checks if the folder exists and then deletes it
folderpath_1 = path & r2 & "\" & "Flat Files"

If fso.FolderExists(folderpath_1) Then

    fso.DeleteFolder (folderpath_1)

End If

Set r2 = r2.Offset(1, 0)

DoEvents
Loop

'Loops through and deletes the "INACTIVE" Final Flat Files (.txt)
Set r = Cells(1, 5)

Do Until r = ""
    If UCase(r.Value) = "INACTIVE" Then
        'Checks if the extracted flat file exists.
        If Dir(path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt") <> "" Then
            Kill path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt"
        End If
    End If
    Set r = r.Offset(1, 0)
Loop
End Sub

Answer 1

尝试下面的代码。我使用了Dir()命令/功能。这使您可以获取路径中存在的所有文件夹/文件。

Sub DeleteSpecificFilesAndFolders()

'This module deletes Extracted Files folders, Flat Files folders and Final Flat Files (.txt format)

Const path = "C:\Users\N\Desktop\Kill_function_test\Test folder for deleting\"

Dim r As Range
Dim folderpath As String
Dim folderpath_1 As String
Dim FolderName As String 

Dim fso As FileSystemObject
Set fso = New Scripting.FileSystemObject

FolderName=Dir(Path & "*", vbDirectory)

While FolderName <> ""

if Not FolderName like "*.*" then  'This is because when using Dir(,vbdirectory) you can get . and .. or if files exist

  folderpath = path & FolderName & "\" & "Extracted Files"


  'Checks if the folder exists and then deletes it.
  If fso.FolderExists(folderpath) Then

      fso.DeleteFolder (folderpath)

  End If


  'Checks if the folder exists and then deletes it
  folderpath_1 = path & FolderName & "\" & "Flat Files"

  If fso.FolderExists(folderpath_1) Then

      fso.DeleteFolder (folderpath_1)

  End If

end if

FolderName=Dir() 'This will set FolderName to the next folder 

DoEvents
wend

'Loops through and deletes the "INACTIVE" Final Flat Files (.txt)
Set r = Cells(1, 5)

Do Until r = ""
    If UCase(r.Value) = "INACTIVE" Then
        'Checks if the extracted flat file exists.
        If Dir(path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt") <> "" Then
            Kill path & r.Offset(0, -4) & "\" & "Final Flat Files" & "\" & r.Offset(0, 1) & ".txt"
        End If
    End If
    Set r = r.Offset(1, 0)
Loop
End Sub

希望这会有所帮助

删除Excel电子表格中找不到的文件夹中的文件

1 个答案: