MS Access VBA Delete Empty Folders - ms-access

Question

I have a list of folder paths I need to delete on a regular basis via an Access program. I only want to delete them if all of the sub folders are empty. How do I delete an empty folder via VBA? This is my code but it doesn't do anything.
I call it via:
PrepareDirModified ("C:\Users\xxxxxxx\Desktop\New folder\TEST123\test456")
Here is the main sub:
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

I used the FileScripting Object to delete a whole series of files then folders, something like;
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
The below blatantly copied from Ron's excellent site https://www.rondebruin.nl/win/s9/win003.htm
You can check a folder exists using the same object;
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
And you can check if a file exists in the same way;
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
In order to iterate through the folders I would use this script;
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
Copied from here http://www.freevbcode.com/ShowCode.asp?ID=7821