Excel VBA: удалить любой пустой файл Excel в папке

#excel #vba #file #directory

#excel #vba #файл #каталог

Вопрос:

Я хотел бы иметь возможность искать папку .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 amp; "*.xls*")

Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath amp; 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
  

Комментарии:

1. Во всех книгах будет хотя бы один лист

2. В дополнение к тому, что сказал @Warcupine, затем вы можете найти следующую пустую ячейку для каждого листа и использовать начальную ячейку в качестве диапазона, чтобы проверить, верно ли это. Это должно помочь.

3. @Mike в ваш принятый ответ были внесены некоторые важные обновления после того, как вы его приняли

Ответ №1:

Попробуйте следующий способ, пожалуйста:

 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 amp; "*.xls*")

 Do While Filename <> ""
    previousSecurity = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Set wb = Workbooks.Open(Filename:=FolderPath amp; 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 amp; Filename
    Filename = Dir()
 Loop
End Sub
  

Комментарии:

1. @chris neilsen: Конечно, это должно быть ws.UsedRange ! Я протестировал строку кода на новом пустом листе и забыл адаптировать ее к рабочему листу итерации. Неплохо отключить макросы. Я тоже это сделаю. Даже если менее вероятно (я думаю, он должен упомянуть об этом), что будут задействованы листы другого типа, я адаптирую код для обработки, как указано выше, только рабочих листов. Я бы предположил, что если такие листы, не относящиеся к рабочему столу, существуют, они существуют с определенной целью. Если ему также нужно проверить их на пустоту, он должен указать это… Спасибо! Отредактировано: адаптировано.

2. Я взял на себя смелость внести некоторые исправления в ваше обновление. Надеюсь, вы не возражаете

3. @chris neilsen: Конечно, нет. Я пропустил previousSecurity объявление и присвоил ему значение… Спасибо!

Ответ №2:

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

    If Application.WorksheetFunction.CountA(ws.Cells()) > 0 Then
        MsgBox "the Sheet " amp; ws.Name amp; " contents data "
         
        Exit For
    Else
      
     MsgBox "no data in " amp; ws.Name
    End If
   
    
    Next ws
    
    Workbooks(Filename).Close
    Filename = Dir()

Loop
  

Комментарии:

1. Этот код отобразит окно с сообщением о том, содержит ли файл данные или нет, но не уничтожает файл, если данные не найдены.

2. вместо MsgBox я позволяю вам создать код для удаления файла. например, этот Dim fso как новый объект файловой системы, aFile как File if (fso.FileExists(«pathToFile»)), затем aFile = fso.GetFile(«pathToFile») aFile . Удалить End, если