asked on

Deleting folder and files with fso

Hello all,

The code below works fine for deleting files but how can I, it at all possible, get it to delete folders as well? Also is there any way to get the message box to show the number of files/folders deleted?

Private Sub cmdYesD_Click()
    Dim File1 As File
    Dim FileCollection As Folder
    Dim fso As New FileSystemObject
    Dim strRegion2 As String
    Dim intDays2 As Integer
    
    strRegion2 = Me.txtRegionConf.Text
    intDays2 = Me.txtInputDays.Text
'Deletes Files
    If fso.FolderExists("Z:\" & strRegion2 & "\Customer\Output") Then
        Set FileCollection = fso.GetFolder("Z:\" & strRegion2 & "\Customer\Output")
        For Each File1 In FileCollection.Files
            If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
                fso.DeleteFile (File1)
             MsgBox "Operation Complete"
 
'Reload combobox on main form
'Load Regions From File
    Dim the_file As String
    the_file = "C:\Documents and Settings\hbc1636\Desktop\regions.txt"
'open the file
    Open the_file For Input As #1
    While Not EOF(1)
'read in a line
    Line Input #1, temp
'add that line to the combobox
    If Len(temp) <> 0 Then Main.cboSelectRegion.AddItem temp
    Wend
'close the file
    Close #1
'Hide current form and show main
             Me.Hide
             frmFFMMain.Show
    Else
        'MsgBox "No files fit range"
            'Me.Hide
            'frmFFMMain.Show
            End If
        Next
    Else
        MsgBox "Error: Region not Found"
            Me.Hide
            frmFFMMain.Show
    End If
            
    'Me.Hide
    'frmFFMMain.Show
    
End Sub

Open in new window

asawatzki

fso.deletefolder(folder1, True)

should work to delete folders

as far as the msgbox you should increment a variable with each deletion. For example:

iDeleted = 0
For each file1 in subfolder
If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
fso.DeleteFile (File1)
iDeleted = iDeleted + 1
End If
Next
MsgBox "Operation Complete. Deleted " & iDeleted & " files."

NUPE2006

ASKER

OK thanks, I'll give it a try. where do I input "fso.deletefolder(folder1, True)"? after the "fso.DeleteFile (File1)" or before? Or does it even matter?

asawatzki

If the folder you want to delete is the one you are getting the filecollection from then this should suffice:

iDeleted = 0
If fso.FolderExists("Z:\" & strRegion2 & "\Customer\Output") Then
Set FileCollection = fso.GetFolder("Z:\" & strRegion2 & "\Customer\Output")

For Each File1 In FileCollection.Files
If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
fso.DeleteFile (File1)
iDeleted = iDeleted + 1
End If
Next
Set FileCollection = nothing
fso.deletefolder("Z:\" & strRegion2 & "\Customer\Output", True)
End If
MsgBox "Operation Complete. Deleted " & iDeleted & " files."

NUPE2006

ASKER

I wanted to basically use the same criteria as I used for the files. The path leads to a collection of files and folders.

asawatzki

What criteria did you want to use for deleting the folder? Most times the modified date on the folder won't match up with the one on the file.

NUPE2006

ASKER

I want the criteria to be not older than "intDays2" old for example: I want the program to delete all files and folders at least intDays2 old

intDays2 = 80

asawatzki

So there are subfolders in the Output folder? Or do you want to delete the Output folder itself?

NUPE2006

ASKER

There are subfolders. I want to delete those and not the actual Output folder.

asawatzki

iDeleted = 0
iDeletedFolder = 0
If fso.FolderExists("Z:\" & strRegion2 & "\Customer\Output") Then
Set FileCollection = fso.GetFolder("Z:\" & strRegion2 & "\Customer\Output")

For Each File1 In FileCollection.Files
If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
fso.DeleteFile (File1)
iDeleted = iDeleted + 1
End If
Next
For Each Folder1 in FileCollection.SubFolders
If DateDiff("d", FileDateTime(Folder1), Now) >= intDays2 Then
fso.DeleteFolder(Folder1, True)
iDeletedFolder = iDeletedFolder + 1
End If
Next
Set FileCollection = nothing

End If
MsgBox "Operation Complete. Deleted: " & vbcrlf & iDeleted & " files and " & vbcrlf & iDeletedFolders & " Folders"

NUPE2006

ASKER

I get error " sub or function not defined when I run:

For Each Folder1 In FileCollection.Files
If DateDiff("d", FolderDateTime(Folder1, True), Now) >= intDays2 Then
fso.DeleteFolder (Folder1)
intDelete = intDelete + 1
End If

and the section -FolderDateTime- is highlighted

NUPE2006

ASKER

I get error " sub or function not defined when I run the code you gave as well and the section FolderDateTime
is highlighted

asawatzki

Ah. That function FolderDateTime doesn't exist. Ok try using the object DateCreated property as below:

iDeleted = 0
iDeletedFolder = 0
If fso.FolderExists("Z:\" & strRegion2 & "\Customer\Output") Then
Set FileCollection = fso.GetFolder("Z:\" & strRegion2 & "\Customer\Output")

For Each File1 In FileCollection.Files
If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
fso.DeleteFile (File1)
iDeleted = iDeleted + 1
End If
Next
For Each Folder1 in FileCollection.SubFolders
If DateDiff("d", Folder1.DateCreated, Now) >= intDays2 Then
fso.DeleteFolder(Folder1, True)
iDeletedFolder = iDeletedFolder + 1
End If
Next
Set FileCollection = nothing

End If
MsgBox "Operation Complete. Deleted: " & vbcrlf & iDeleted & " files and " & vbcrlf & iDeletedFolders & " Folders"

NUPE2006

ASKER

ok we (you) got that fixed but now it has a problem with the last
Next
it says
compile error: next with out for

asawatzki

Can you check to make sure there isn't an extra next in there somewhere? Maybe try pasting that Sub back up again.

NUPE2006

ASKER

this what I have. I'm checking through it now. I ran it with the last few lines commented out

Next
FileCollection = Nothing
End If

it worked but the message box came up for every instance. If I find the error will it just come up at the end with total numbers?

Private Sub cmdYesD_Click()
    Dim File1 As File
    Dim Folder1 As Folder
    Dim FileCollection As Folder
    Dim fso As New FileSystemObject
    Dim strRegion2 As String
    Dim intDays2 As Integer
    Dim intDelete As Integer
    
    strRegion2 = Me.txtRegionConf.Text
    intDays2 = Me.txtInputDays.Text
'Deletes Files
    intDelete = 0
    If fso.FolderExists("Z:\" & strRegion2 & "\Customer\Output") Then
        Set FileCollection = fso.GetFolder("Z:\" & strRegion2 & "\Customer\Output")
        'search for and delete files
        For Each File1 In FileCollection.Files
            If DateDiff("d", FileDateTime(File1), Now) >= intDays2 Then
                fso.DeleteFile (File1)
                intDelete = intDelete + 1
            End If
    Next
        For Each Folder1 In FileCollection.SubFolders
        intDeleteFolder = 0
            If DateDiff("d", Folder1.DateCreated, Now) >= intDays2 Then
                fso.DeleteFolder (Folder1)
                intDeleteFolder = intDeleteFolder + 1
            Next
                FileCollection = Nothing
            End If
    MsgBox "Complete.  Deleted: " & vbCrLf & intDelete & " files and " & vbCrLf & intDeleteFolders & " Folders"
            
        'search for and delete folders
        'For Each Folder1 In FileCollection.Files
            'If DateDiff("d", FolderDateTime(Folder1, True), Now) >= intDays2 Then
                'fso.DeleteFolder (Folder1)
                'intDelete = intDelete + 1

Open in new window

asawatzki

Here's there is an If clause that is not closed before a Next. So this:

For Each Folder1 In FileCollection.SubFolders
intDeleteFolder = 0
If DateDiff("d", Folder1.DateCreated, Now) >= intDays2 Then
fso.DeleteFolder (Folder1)
intDeleteFolder = intDeleteFolder + 1
Next
FileCollection = Nothing
End If

should read:
intDeleteFolder = 0
For Each Folder1 In FileCollection.SubFolders
If DateDiff("d", Folder1.DateCreated, Now) >= intDays2 Then
fso.DeleteFolder (Folder1)
intDeleteFolder = intDeleteFolder + 1
End If
Next
FileCollection = Nothing

nffvrxqgrcfqvvc

Another approach...

Option Explicit
 
Private Const FO_DELETE             As Long = &H3
Private Const FOF_SILENT            As Long = &H4
Private Const FOF_NOCONFIRMATION    As Long = &H10
 
Private Type SHFILEOPSTRUCT
   hwnd                     As Long
   wFunc                    As Long
   pFrom                    As Long
   pTo                      As Long
   fFlags                   As Long
   fAnyOperationsAborted    As Long
   hNameMappings            As Long
   lpszProgressTitle        As Long
 End Type
 
Private Declare Function SHFileOperationW Lib "shell32" (ByVal SHFILEOPSTRUCT As Long) As Long
 
Public Sub DeleteAll(ByVal strDir As String)
    ' Delete all files folders
    Dim OPSTRUCT    As SHFILEOPSTRUCT
    Dim DoubleNull  As String
    
    DoubleNull = (vbNullChar & vbNullChar)
    OPSTRUCT.wFunc = FO_DELETE
    OPSTRUCT.pFrom = StrPtr(strDir & DoubleNull)
    OPSTRUCT.fFlags = FOF_SILENT Or FOF_NOCONFIRMATION
    SHFileOperationW VarPtr(OPSTRUCT)
    
    ' DeleteAll "e:\test\*.*"   'Delete all but keep root folder
    ' DeleteAll "e:\test"       'Delete all even root folder
End Sub

Open in new window

NUPE2006

ASKER

now I'm getting

compile error:
invalid use of property

Filecollection= ...is highlighted

ASKER CERTIFIED SOLUTION

asawatzki

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

NUPE2006

ASKER

got it...thanks

NUPE2006

ASKER

Thanks for everything. I appreciate you taking your time to help me.