Question

我有一个文件夹路径列表，需要定期通过Access程序删除。如果所有子文件夹都为空，我只想删除它们。如何通过VBA删除空文件夹？这是我的代码，但是它什么也没做。

我通过以下方式致电

PrepareDirModified ("C:\Users\xxxxxxx\Desktop\New folder\TEST123\test456")

这是主要子目录：

Public Sub PrepareDirModified(dirStr As String)
On Error Resume Next
    If Right(dirStr, 1) <> "\" Then dirStr = dirStr & "\"
    Kill dirStr & "*.*"
    RmDir dirStr
    MkDir dirStr
On Error GoTo 0
End Sub

Answer 1

我使用FileScripting对象删除了一系列文件，然后删除了文件夹，类似;

   Dim FSO As Object   

   Set FSO = CreateObject("scripting.filesystemobject")
   On Error GoTo FileError
            'Delete files
   FSO.deletefile mypath & "\*.*", True
            'Delete subfolders
   FSO.deletefolder mypath & "\*.*", True

以下内容是从罗恩出色的网站https://www.rondebruin.nl/win/s9/win003.htm

中复制的

您可以使用同一对象检查文件夹是否存在；

Dim FSO As Object
Dim FolderPath As String

Set FSO = CreateObject("scripting.filesystemobject")

FolderPath = "C:\Users\Ron\test"
If Right(FolderPath, 1) <> "\" Then
    FolderPath = FolderPath & "\"
End If

If FSO.FolderExists(FolderPath) = False Then
    MsgBox "Folder doesn't exist"
Else
    MsgBox "Folder exist"
End If

您可以检查文件是否以相同的方式存在；

  Dim FSO As Object
Dim FilePath As String

Set FSO = CreateObject("scripting.filesystemobject")

FilePath = "C:\Users\Ron\test\book1.xlsm"

If FSO.FileExists(FilePath) = False Then
    MsgBox "file doesn't exist"
Else
    MsgBox "File exist"
End If
End Sub

为了遍历文件夹，我将使用此脚本；

    Public Sub DeleteEmptyFolders(ByVal strFolderPath As String)
   Dim fsoSubFolders As Folders
   Dim fsoFolder As Folder
   Dim fsoSubFolder As Folder

   Dim strPaths()
   Dim lngFolder As Long
   Dim lngSubFolder As Long

   DoEvents

   Set m_fsoObject = New FileSystemObject
   If Not m_fsoObject.FolderExists(strFolderPath) Then Exit Sub

   Set fsoFolder = m_fsoObject.GetFolder(strFolderPath)

   On Error Resume Next

   'Has sub-folders
   If fsoFolder.SubFolders.Count > 0 Then
        lngFolder = 1
        ReDim strPaths(1 To fsoFolder.SubFolders.Count)
        'Get each sub-folders path and add to an array
        For Each fsoSubFolder In fsoFolder.SubFolders
            strPaths(lngFolder) = fsoSubFolder.Path
            lngFolder = lngFolder + 1
        Next fsoSubFolder

        lngSubFolder = 1
        'Recursively call the function for each sub-folder
        Do While lngSubFolder < lngFolder
           Call DeleteEmptyFolders(strPaths(lngSubFolder))
           lngSubFolder = lngSubFolder + 1
        Loop
    End If

    'No sub-folders or files
    If fsoFolder.Files.Count = 0 And fsoFolder.SubFolders.Count = 0 Then
        fsoFolder.Delete
    End If
    End Sub

从这里http://www.freevbcode.com/ShowCode.asp?ID=7821复制

MS Access VBA删除空文件夹

1 个答案: