Deleting files in sub folders

[sbarber007]

Hi All

I am trying to delete all files in sub folders with the code below, but not delete the sub folders which this code below does.

Regards

Steve

   Dim OFS, Sfolder, Subfolder, File, Folder
           Set OFS = CreateObject("Scripting.FileSystemObject")

           Sfolder = "d:\Images\" & NextMonth

           For Each Subfolder In OFS.GetFolder(Sfolder).SubFolders

           For Each File In OFS.GetFolder(Subfolder.Path).Files
           OFS.DeleteFile File.Path, True
           Next
           For Each Folder In OFS.GetFolder(Subfolder.Path).SubFolders

           OFS.DeleteFolder Folder.Path
           Next
           Next

           Set OFS = Nothing

[Arnoutdv]

On a first glance I would say remove the following lines:

For Each Folder In OFS.GetFolder(Subfolder.Path).SubFolders
  OFS.DeleteFolder Folder.Path
Next

[sbarber007]

@Arnoutdv

First thing I thought of but it wont delete the files in those sub folders

[Arnoutdv]

Deleting the files seems an unnecessary step when deleting folders:

https://msdn.microsoft.com/en-us/vba...efolder-method

The specified folder is deleted regardless of whether or not it has contents.

But you only want to delete the files not the folders.
So you need to delete all files in in a folder, if subfolders are found then call the file delete routine to delete the files

Sample on stackoverflow (ignore the If objFile.DateCreated < Date - 180 Then):
https://stackoverflow.com/questions/...s-older-than-6

[Elroy]

Hi sbarber007,

Here's some old code I've got that does what you're wanting (delete all files in folder and all sub-folders without deleting folders). I just pulled it out of a much larger program.

To test, I just created two ListBoxes and one Button on a Form1. The ListBoxes are as follows:

• First one named lstFolders with Index property set to 0 (not blank).
• Second one named lstFiles with Index property set to 0 (not blank).

Optionally, you could set their visibility property to false if you wanted.

And then, the command button was just named Command1.

Here's the code (thrown into Form1):

Option Explicit
'

Private Sub Command1_Click()
    DeleteAllFilesInFolder "C:\Users\Elroy\Desktop\New folder"
End Sub

Private Sub DeleteAllFilesInFolder(ByVal sDestination As String, Optional lRecursionLevel As Long)
    ' This deletes all files in the folder, and all files in all sub-folders.
    ' None of the folder (nor sub-folders) are deleted.
    '
    sDestination = sAddSlashIfNeeded(sDestination)
    '
    ' Create controls for sub-folder recursion.
    If lRecursionLevel <> 0 Then
        Load lstFolders(lRecursionLevel)
        Load lstFiles(lRecursionLevel)
    End If
    '
    FillFolderListBox lstFolders(lRecursionLevel), sDestination     ' Set destination folder.
    FillFileListBox lstFiles(lRecursionLevel), sDestination
    TraverseDestinationSubFolders sDestination, lRecursionLevel     ' Go through sub-folders.
    DeleteTheFiles sDestination, lRecursionLevel                    ' Delete any files.
    '
    ' Destroy controls for sub-folder recursion.
    If lRecursionLevel <> 0 Then
        Unload lstFolders(lRecursionLevel)
        Unload lstFiles(lRecursionLevel)
    End If
End Sub

Private Sub FillFolderListBox(lst As ListBox, sPath As String)
    Dim s As String
    '
    lst.Clear
    s = Dir$(sPath & "*.*", vbDirectory + vbReadOnly + vbHidden + vbSystem)
    Do While Len(s) <> 0
        Select Case True
        Case s = "."
        Case s = ".."
        Case bFolderExists(sPath & s)
            lst.AddItem s
        End Select
        s = Dir$
    Loop
End Sub

Private Sub FillFileListBox(lst As ListBox, sPath As String)
    Dim s As String
    '
    lst.Clear
    s = Dir$(sPath & "*.*", vbNormal + vbReadOnly + vbHidden + vbSystem)
    Do While Len(s) <> 0
        lst.AddItem s
        s = Dir$
    Loop
End Sub

Private Sub TraverseDestinationSubFolders(sDestination As String, lRecursionLevel As Long)
    Dim iLoop As Long
    Dim sNewDestination As String
    Dim lNewRecursionLevel As Long
    '
    For iLoop = 0 To lstFolders(lRecursionLevel).ListCount - 1
        sNewDestination = sDestination & lstFolders(lRecursionLevel).List(iLoop)
        lNewRecursionLevel = lRecursionLevel + 1
        ' Recurse to main copy procedure.
        DeleteAllFilesInFolder sNewDestination, lNewRecursionLevel
    Next iLoop
End Sub

Private Sub DeleteTheFiles(sDestination As String, lRecursionLevel As Long)
    Dim iLoop As Long
    Dim sDFile As String
    Dim sFileName As String
    '
    For iLoop = 0 To lstFiles(lRecursionLevel).ListCount - 1
        sFileName = lstFiles(lRecursionLevel).List(iLoop)
        sDFile = sDestination & sFileName
        Kill sDFile
    Next iLoop
End Sub

Private Function bFolderExists(sDir As String) As Boolean
    Const FILE_ATTRIBUTE_REPARSE_POINT = 1024 ' Junction point (not a real folder).
    Dim b As Boolean
    Dim i As Long
    '
    On Local Error GoTo FolderExistsError
    ' If no error then something existed.
    If Len(sDir) <> 0 Then
        b = ((GetAttr(sDir) And vbDirectory) = vbDirectory)
        If Not b Then
            bFolderExists = False
        Else
            i = GetAttr(sAddSlashIfNeeded(sDir) & ".")
            bFolderExists = (i And FILE_ATTRIBUTE_REPARSE_POINT) = 0
        End If
    Else
        bFolderExists = False
    End If
    Exit Function
FolderExistsError:
    bFolderExists = False
    Exit Function
End Function

Private Function sAddSlashIfNeeded(s As String) As String
    If Right$(s, 1) <> "\" Then
        sAddSlashIfNeeded = s & "\"
    Else
        sAddSlashIfNeeded = s
    End If
End Function

Also, if you wanted to set up Collections, or maybe even arrays of Collections, you could do away with the ListBoxes. And then, you could do away with any need for dependency on a form.

Enjoy,
Elroy

p.s. I suspect there are faster ways to do this, but this one certainly gets it done.

[MarkT]

Pretty straight forward using the filesystemobject

Private Sub Command1_Click()
Dim fso As FileSystemObject
Dim fld As folder
Dim strStartingDir As String

    Set fso = New FileSystemObject
    strStartingDir = "d:\Images\" & NextMonth
    Set fld = fso.GetFolder(strStartingDir)
    DeleteFilesInFoleder fld
    Set fso = Nothing

End Sub


Private Sub DeleteFilesInFoleder(fld As folder)
Dim fold As folder
Dim fil As File

    For Each fold In fld.SubFolders
        DeleteFilesInFoleder fold
    Next fold

    For Each fil In fld.Files
        fil.Delete True
    Next fil
End Sub

[Elroy]

Ok, I decided to tighten up the code I posted in post #5. Here it is without the need for a form or any controls or dependencies.

Just put Command1 on a form to test (and change the folder to your own):

Option Explicit
'

Private Sub Command1_Click()
    DeleteAllFilesInFolder "C:\Users\Elroy\Desktop\New folder"
End Sub

Public Sub DeleteAllFilesInFolder(ByVal sTargetFolder As String)
    ' This deletes all files in the folder, and all files in all sub-folders.
    ' None of the folder (nor sub-folders) are deleted.
    ' Make sure sTargetFolder exists on initial call, or nothing will happen.
    '
    Dim s As String
    Dim cFolders As New Collection                                                  ' Will self-destruct.
    Dim cFiles As New Collection                                                    ' Will self-destruct.
    Dim vItem As Variant
    '
    If Right$(sTargetFolder, 1) <> "\" Then sTargetFolder = sTargetFolder & "\"     ' Make sure we're "\" terminated.
    '
    ' Gather all sub-folders.
    s = Dir$(sTargetFolder & "*.*", vbDirectory + vbReadOnly + vbHidden + vbSystem)
    Do While Len(s) <> 0
        Select Case True
        Case s = "."
        Case s = ".."
        Case (GetAttr(sTargetFolder & s) And vbDirectory) = vbDirectory:    cFolders.Add s
        End Select
        s = Dir$
    Loop
    '
    ' Traverse into each sub-folder via recursion.
    For Each vItem In cFolders
        DeleteAllFilesInFolder sTargetFolder & vItem
    Next vItem
    '
    ' When we're at the bottom (i.e., nothing in cFolders), of a tree-part, gather files.
    s = Dir$(sTargetFolder & "*.*", vbNormal + vbReadOnly + vbHidden + vbSystem)
    Do While Len(s) <> 0
        cFiles.Add s
        s = Dir$
    Loop
    '
    ' Now delete the files at this level.
    For Each vItem In cFiles
        Kill sTargetFolder & vItem
    Next vItem
End Sub

Enjoy,
Elroy

[Zvoni]

Errr.....? hu?

Why not just use the API SHFileOperation
with
wFunc=FO_DELETE
fFlags=FOF_FILESONLY

in SHFILEOPSTRUCT

Not tested, but it should nuke all files in a given Folder, not deleting Folder/SubFolder

[ChrisE]

Hi,

in my opinion it is easier to delete the Folder with Files and the recreate the Folder structure.

here a sample to create a Folder structure like ... C:\Chris\Test\Test2\Test3

Option Explicit

Private Sub Command1_Click()
 Dim Msg As String
   Dim Titel As String
   Dim IsOk As Boolean
   Dim Result As String
   Dim i As Long
  Dim s As String
      Titel = "Create Folder "
      Do
         Msg = "Enter Path and Foldernames.... " & _
                vbNewLine & _
               vbCrLf & "sample: D:\MyDB\MyPic\MyHelp"
         Result = InputBox(Msg, "Create Path\Folder(s)")
         If Len(Result) = 0 Then
         Msg = "you did not enter a Path\Folder"
          MsgBox Msg, vbInformation, Titel
            Exit Sub
         End If
          s = Result
         IsOk = True
          If IsOk Then
            s = Result
       MsgBox FolderCreateNew(s)
            Exit Sub
         End If
      Loop
End Sub
Public Function FolderCreateNew(Path As String, _
                             Optional ShowError As Boolean = True) As Boolean

   Dim s As String
   Dim s1() As String
   Dim s2 As String
   Dim Titel As String
   Dim i As Long
   
      Titel = "FolderCreate"
      If Len(Trim(Path)) = 0 Then
         If ShowError Then
            FehlerAnzeige 4711, "Path without Folder", Titel
         End If
         Exit Function
      End If
      s = Replace(Trim(Path), "\\", "\")
      If Right(s, 1) = "\" Then
         s = Left$(s, Len(s) - 1)
      End If
      s1() = Split(s, "\")
      'gibt es den Pfad schon
      s2 = Join(s1(), "\")
      If Len(Dir(s2, vbDirectory)) > 0 Then
         If ShowError Then
            FehlerAnzeige 4712, "Path " & Path & vbCrLf & _
                          "exits", Titel
         End If
         Exit Function
      End If
      s2 = s1(LBound(s1))
      'test for Drive
      If Len(Dir(s2)) = 0 Then
         If ShowError Then
            FehlerAnzeige 4712, "Drive " & s2 & " does not exist", Titel
         End If
         Exit Function
      End If
      On Error GoTo Fehler
      For i = LBound(s1) + 1 To UBound(s1)
         s2 = s2 & "\" & s1(i)
         If Len(Dir(s2, vbDirectory)) = 0 Then
            'Folder doesn't exist so create it
            MkDir s2
         End If
      Next
      FolderCreateNew = True
      Exit Function
Fehler:
      If ShowError Then
         FehlerAnzeige Err.Number, Err.Description, Titel
      End If
End Function

Public Sub FehlerAnzeige(ErrNumber As Long, ErrDescription As String, _
                         Optional Titel As String = "")

   Dim Msg As String
   
      Msg = "Fehler " & ErrNumber & vbCrLf & vbCrLf & _
            ErrDescription
      MsgBox Msg, vbCritical, Titel
End Sub

regards
Chris

[Zvoni]

First thing:
Me and my own memory.
I knew the OP's Name was familiar, and even the Topic
Look what i found from some 3-4 years ago:
http://www.vbforums.com/showthread.p...after-6-months

Second@ChrisE
Why would you do that???
As i mentioned: with the API you can delete all files in a given Folder.
IF you expand the code to include a Dir-Statement first checking for Subfolders (If Yes, then do a recursive call, if no continue),
you can delete all files in a folder including subfolders without destroying the folder-structure/-tree.

At a guess: maybe not even 20 Lines of code.

[ChrisE]

Hi,

that sounds good..

Second@ChrisE
Why would you do that???
As i mentioned: with the API you can delete all files in a given Folder.
IF you expand the code to include a Dir-Statement first checking for Subfolders (If Yes, then do a recursive call, if no continue),
you can delete all files in a folder including subfolders without destroying the folder-structure/-tree.

At a guess: maybe not even 20 Lines of code.

can you post the code to do that

regards
Chris

[ColinE66]

Hi,

in my opinion it is easier to delete the Folder with Files and the recreate the Folder structure.

Seems dangerous. What would you do if your program crashed before it had the chance to re-create the folder structure that the user had set-up?

[ChrisE]

Seems dangerous. What would you do if your program crashed before it had the chance to re-create the folder structure that the user had set-up?

Hi Colin,

on second thought I think I would use this...

'Folder structure for testing was C:\ChrisTest\Test1\Test2\Test3

Private Sub Command1_Click()
    Dim command As String
    command = "del C:\ChrisTest /s /f /q "
    'write to Textfile what was deleted
    Shell "cmd.exe /c " & command & "> ""C:\LogDeletedFiles.txt"""
End Sub

it will delete all Files and not touch the Folders, which Files were deleted will be writen to a Text file

regards
Chris

[Zvoni]

For Deleting Content only of Folders incl./excl. SubFolders (Leaving the Folder-Tree intact) with Flag for "Are you sure you want to Delete?"-Message

As you can see: the actual code is 16 Lines long (without the Declares and what not)

'###### Declares for SHFileOperation

Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40
Const FOF_SILENT = &H4
Const FOF_NOCONFIRMATION = &H10
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMMKDIR = &H200
Const FOF_FILESONLY = &H80

Private Type SHFILEOPSTRUCT
    hwnd      As Long
    wFunc     As Long
    pFrom     As String
    pTo       As String
    fFlags    As Integer
    fAborted  As Boolean
    hNameMaps As Long
    sProgress As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    
Private SHFileOp As SHFILEOPSTRUCT
'####### Declares for FindFirst, FindNext, FindClose

Private Declare Function FindFirstFile Lib "kernel32" _
        Alias "FindFirstFileA" (ByVal lpFileName As String, _
        lpFindFileData As WIN32_FIND_DATA) As Long
        
Private Declare Function FindNextFile Lib "kernel32" _
        Alias "FindNextFileA" (ByVal hFindFile As Long, _
        lpFindFileData As WIN32_FIND_DATA) As Long
        
Private Declare Function FindClose Lib "kernel32" (ByVal _
        hFindFile As Long) As Long

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Const MAX_PATH As Long = 259&

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Const FILE_ATTRIBUTE_READONLY As Long = &H1&
Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&

'START FROM HERE - adjust Path as you need    
Private Sub Main()

    SHFileOp.wFunc = FO_DELETE
    SHFileOp.fFlags = FOF_FILESONLY
    
    NukeFiles "C:\Temp\TestFolder", True, False

End Sub

Private Sub NukeFiles(ByVal StartFolder As String, ByVal IncludeSubs As Boolean, ByVal Confirm As Boolean)
Dim Folder As String
Dim File As String
Dim hFile As Long
Dim FD As WIN32_FIND_DATA
       
    If Not Confirm Then SHFileOp.fFlags = FOF_FILESONLY + FOF_NOCONFIRMATION
    
    Folder = StartFolder & "\*.*"
    
    'Nuke All Files in StartFolder
    SHFileOp.pFrom = Folder
    i = SHFileOperation(SHFileOp)
     
    If IncludeSubs Then
        
        hFile = FindFirstFile(Folder, FD)
    
        Do
            
            File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
                
            If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
        
                If File <> "." And File <> ".." Then
                
                    NukeFiles StartFolder & "\" & File, IncludeSubs, Confirm
                
                End If
            
            End If
            
        Loop While FindNextFile(hFile, FD)
    
    End If

    FindClose hFile

End Sub

As for creating a Folder-Tree: There is a neat API which creates a Folder on your disk (incl. "missing" folders in between).
So to create a complete tree it's a simple For-Next-Loop where you just have to concatanate your Path-Names
The API doesn't care if a folder exists already. It just doesn't do anything in that case.

But for the Life of me i can't remember the name of the API (something alike "MakeSurePathNameExists" or something)

EDIT: As a sidenote: The Code/API above takes wildcards, meaning you can take a complete Folder-Tree incl. SubFolders and,
say "Delete all PDF's inside this Tree"
Just change the Line

Folder = StartFolder & "\*.*"

'into
Folder = StartFolder & "\*.pdf"

or pass it the file-extension as a additional parameter.
It would delete all PDF's in the Folder-Tree starting at StartFolder

[Zvoni]

Found it

To create a Folder incl. SubFolders:

Private Declare Function MakeSureDirectoryPathExists Lib "IMAGEHLP.DLL" (ByVal DirPath As String) As Long

And here's an alternative:

http://allapi.mentalis.org/apilist/S...ectoryEx.shtml

[sbarber007]

Hi All
Thanks for your help.