Excel VBA：删除文件夹中的任何空Excel文件

Mike 发表于 Dev

麦克风

我希望能够搜索 .xls 文件的文件夹并从空文件夹中删除任何文件。当我说空时，我的意思是文件中没有工作表，或者任何单元格中都没有任何数据（如果工作表确实存在）。这样做的最佳方法是什么？

代码：

Sub DeleteEmptyFiles()

Dim FolderPath As String
Dim Filename As String
Dim ws As Worksheet

Application.ScreenUpdating = False

FolderPath = "Enter the folder path here"
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each ws In ActiveWorkbook.Sheets

    'DELETE FILE IF EMPTY

    Next ws
    
    Workbooks(Filename).Close
    Filename = Dir()

Loop

Application.ScreenUpdating = True

End Sub

法尼杜鲁

请尝试下一种方法：

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

 FolderPath = "Enter the folder path here" 'Take care to end the folder path in "\"
                                           'Otherwise, build the file full name inserting "\"
 Filename = Dir(FolderPath & "*.xls*")

 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

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。