CODEWITHSUNDEEP
excelvba
visshnu
visshnu

Reputation: 99

Delete Empty Excel Files in a Folder in different extensions

i have found this vba code and applied in my excel workbook to delete empty excel files in a folder path in given this code here this vba code is not deleting any empty excel files in a given folder path why it's not deleting any empty excel files in folder i don't understand

this is my folder path

C:\Users\Visshnu\Desktop\Excel Files

in this folder i have excel files in two different extensions one is .xlsm and another .xlsx

i have applied code like this


Sub DeleteEmptyFiles()
 Dim FolderPath As String, Filename As String, wb As Workbook
 Dim ws As Worksheet, boolNotEmpty As Boolean
 Dim previousSecurity As MsoAutomationSecurity

 FolderPath = "C:\Users\Visshnu\Desktop\Excel Files\" 
                                           
 Filename = Dir(FolderPath & "*.xlsm*","*.xlsx*")

 Do While Filename <> ""
    previousSecurity = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Set wb = Workbooks.Open(Filename:=FolderPath & Filename)
    Application.AutomationSecurity = previousSecurity
    
    boolNotEmpty = False
    For Each ws In wb.Worksheets
        If WorksheetFunction.CountA(ws.UsedRange) > 0 Then
            boolNotEmpty = True: Exit For
        End If
    Next ws
    wb.Close False
    If Not boolNotEmpty Then Kill FolderPath & Filename
    Filename = Dir()
 Loop
End Sub

Upvotes: 1

Views: 126

Answers (1)

Storax
Storax

Reputation: 12167

A quick fix of your code would be

Option Explicit

Sub DeleteEmptyFiles()
    Dim FolderPath As String, Filename As String, wb As Workbook
    Dim ws As Worksheet, boolNotEmpty As Boolean
    Dim previousSecurity As MsoAutomationSecurity

    FolderPath = "C:\Users\Visshnu\Desktop\Excel Files\"
    FolderPath = "D:\TMP\"
 
    ' Take all files with extension xls which also inlcude xlsb  etc.                                             
    Filename = Dir(FolderPath & "*.xls*") ' , "*.xlsx*")
      

    Do While Filename <> ""

        Dim ext As String
        ' retrieve the extension of the file which Dir returned
        ext = Right(Filename, Len(Filename) - InStrRev(Filename, "."))
        
        ' Check if the extension is XLSX or XLSM 
        ' because these are the extensions we are after
        If UCase(ext) = "XLSM" Or UCase(ext) = "XLSX" Then

            previousSecurity = Application.AutomationSecurity
            Application.AutomationSecurity = msoAutomationSecurityForceDisable
            Set wb = Workbooks.Open(Filename:=FolderPath & Filename)
            Application.AutomationSecurity = previousSecurity
    
            boolNotEmpty = False
            For Each ws In wb.Worksheets
                If WorksheetFunction.CountA(ws.UsedRange) > 0 Then
                    boolNotEmpty = True: Exit For
                End If
            Next ws
            wb.Close False
            If Not boolNotEmpty Then Kill FolderPath & Filename
        
        End If
        
        Filename = Dir()
    
    Loop
End Sub

Upvotes: 2

Related Questions