Thread: Kill all non excel files in folder

Something like:

Sub killfiles(fPath As String)
Dim file As Object
Const ext As String = "xls*"

With CreateObject("scripting.filesystemobject")
    For Each file In .getfolder(fPath).Files
      If Not .getextensionname(file) Like ext Then
            Debug.Print file.Name
            'file.Delete
     End If
    Next
End With

End Sub

You'll need to uncomment the delete part, use it in its current form to see what if would delete

This is something I put together a while back. It also checks subfolders.

Option Explicit

Sub DeleteFiles()

    Dim objFSO
    Dim strPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        .InitialFileName = "E:\Emails\"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            strPath = .SelectedItems(1) & "\"
        Else
            MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
            Exit Sub
        End If
    End With
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Call ProcessFolders(objFSO, strPath)
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    MsgBox "Completed...", vbInformation
    
End Sub

Sub ProcessFolders(ByRef fso, ByVal fpath)

    Dim objFolder
    Dim objSubFolder
    Dim objFile
    Dim wkb As Workbook
    
On Error Resume Next
    Set objFolder = fso.GetFolder(fpath)
    
    For Each objFile In objFolder.Files
        If LCase(objFile.Name) Like "*.xl*" Then Next objFile Else Kill (objFile)
    Next objFile
    
    For Each objSubFolder In objFolder.SubFolders
        Call ProcessFolders(fso, objSubFolder)
    Next objSubFolder

End Sub

Remeber to test it on a non-essential folder first because you can't undelet the files.

abousetta

Hi Kyle,

I would change *.xls* to *.xl* in your code to catch some of the older versions of Excel files like *.xlt.

abousetta

Yep, do as abousetta suggested missed that one

@abousetta, I'm curious as to why you turned off all the Excel updating, events etc... As far as I can see in your code, this would have little effect as you are not doing anything that would trigger any of that. Have I missed something?

Yes, you missed the obvious... my bad habits

I just got used to putting this around all my code and I got lazy and didn't remove it for this particular macro.

abousetta