Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Просмотреть все файлы в папке

Иногда необходимо проделать однотипные операции с несколькими файлами, расположенными в одной папке. Можно открывать каждый по очереди:
Workbooks.Open "C:\Новая папка\Книга1.xlsx"
Workbooks.Open "C:\Новая папка\Книга2.xlsx"

и т.д.
Но если файлов много и все с разными именами, то это не очень практично и совсем лишено гибкости. При помощи Visual Basic for Application можно решить проблему. При этом файлы можно просматривать как в одной папке, так и включая вложенные "подпапки".


 

Все файлы в папке
Ниже приведен код, который перебирает все файлы в папке, открывает их и на первом листе каждого файла записывает текст "www.excel-vba.ru" в ячейку A1:

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    Dim wb As Workbook
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Set wb = Application.Workbooks.Open(sFolder & sFiles)
        'действия с файлом
        'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
        wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
        'Закрываем книгу с сохранением изменений
        wb.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub

sFiles = Dir(sFolder & "*.xls*") - Строка отвечает за тип перебираемых файлов. В примере будут просмотрены любые файлы Excel. Звездочка на конце означает любой символ или набор символов. Т.е. если указать без неё - "*.xls", то будут просмотрены только файлы с расширением xls, а если указать xlsx - то файлы с расширением xlsx и никакие другие.
Если хотите перебрать файлы других форматов, а не Excel, то просто замените "*.xls" на нужное расширение. Например "*.doc". Также, если хотите собрать только файлы с определенными символами/словами в имени, то можно указать так: sFiles = Dir(sFolder & "*отчет*.xls*"). Будут просмотрены все файлы, содержащие в имени слово "отчет"(например "отчет за июнь.xls", "отчет за июль.xls", "сводный отчет.xls" и т.п.).


 

Все файлы включая подпапки
В коде выше есть одна проблема: что если необходимо открыть файлы не только в указанной папке, но и во всех её подпапках? В версиях Excel 2003 и младше это решалось с помощью метода .FileSearch, но в старших версиях данный метод по каким-то причинам был заблокирован разработчиками Microsoft. И осталось действовать только через рекурсивный метод перебора папок. Ниже приведен код, который открывает все файлы Excel в указанной папке, включая все подпапки.
Для этого используется встроенная в офис библиотека File System Object:

Option Explicit
 
Dim objFSO As Object, objFolder As Object, objFile As Object
 
Sub Get_All_File_from_SubFolders()
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetSubFolders sFolder
    Set objFolder = Nothing
    Set objFSO = Nothing
    Application.ScreenUpdating = True
End Sub
Private Sub GetSubFolders(sPath)
    Dim sPathSeparator As String, sObjName As String
    Dim wb As Workbook
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then
            'открываем книгу
            Set wb = Application.Workbooks.Open(sPath & objFile.Name)
            'действия с файлом
            'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
            wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
            wb.Close True 'wb.Close False '- если в коде надо будет закрывать книгу без сохранения
        End If
    Next
    For Each objFolder In objFolder.SubFolders
        GetSubFolders objFolder.Path & Application.PathSeparator
    Next
End Sub

Код делает тоже самое, что и первый, но открывает и изменяет ячейку A1 первого листа для всех файлов Excel в выбранной папке и всех её подпапках(включая все вложенные до последнего уровня).

If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then

Строка отвечает за тип перебираемых файлов. В примере будут просмотрены любые файлы Excel. Звездочка на конце означает любой символ или набор символов. Т.е. если указать без неё - "*.xls", то будут просмотрены только файлы с расширением xls, а если указать xlsx - то файлы с расширением xlsx и никакие другие.
Если добавить условие: If objFSO.GetBaseName(objFile) Like "*книга*" Then
то будут обработаны файлы, которые в имени содержат слово "книга". При этом регистр букв имеет значение. Т.е. если файл содержит в имени слово "Книга", то он не будет обработан.
Думаю теперь Вы легко сможете проделать необходимые операции с множеством файлов.

Скачать пример:

  Все файлы в папке и подпапках.xls (62,5 KiB, 8 637 скачиваний)


В примере я закомментировал строки, открывающие файл и вносящие изменения в ячейку A1 и заменил это созданием списка имен всех файлов в папках и подпапках. По окончании работы кода имена всех файлов записываются в столбец "А" нового листа(лист создается автоматически). Сделано для того, чтобы при тестировании кода случайно не повредить информацию в файлах.


 

Просмотреть все файлы на всех дисках
В последнее время участились вопросы как просмотреть еще и все диски на ПК. Ниже выкладываю код, который просматривает все подключенные диски и просматривает все файлы во всех папках дисков:

Sub Get_All_drives()
    Dim objDrives As Object, objDrive As Object
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDrives = objFSO.Drives
    For Each objDrive In objDrives
        If objDrive.IsReady Then
            GetSubFolders objDrive.DriveLetter & ":\"
        End If
    Next objDrive
End Sub

Для работы кода необходимо разместить его в том же модуле, что и код просмотра файлов в подпапках. Без него код просмотра дисков работать не будет, т.к. обращается к процедуре GetSubFolders(которая и приведена в коде перебора файлов в подпапках).
Скачать пример:

  Все файлы в папке и подпапках.xls (62,5 KiB, 8 637 скачиваний)


В примере код сканирует все диски и выводит в столбец А нового листа(лист создается автоматически) пути ко всем файлам.

Так же см.:
Как средствами VBA переименовать/переместить/скопировать файл
Как сменить формат сразу для нескольких файлов Excel
Как удалить папку или все файлы из папки через VBA
Собрать и просуммировать данные из разных файлов при помощи PowerQuery


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 55 комментариев
  1. Сергей:

    Подскажите, а как сделать, чтобы сканировал определенную папку и выводил название папок (не файлов), хранящихся в первоначальной папке. Т.е. есть папка A в ней хранятся папки C, D и т.д., нужно чтобы Excel вывел название папки виде таблицы (отображал наименование, дату создания, размер) и при добавление новых папок отображал в списке?!

  2. Екатерина:

    Спасибо большое за очень полезный скрипт! Он у меня работает на отлично, если нужно выполнить какие-то простые операции в файлах. Однако, если я вставляю в код действий с файлом операции с функцией Dir (например, мне нужно, чтобы программа создала файл с определённым именем, а затем при открытии следующего файла из указанной папки проверила, есть ли уже файл с таким именем или нет), программа не переходит на следующую ступень цикла и не открывает следующий файл - ругается на строчку sFiles = Dir . Как можно избежать такой проблемы? В программировании я профан, пытаюсь написать свой первый макрос для обработки данных.

  3. Vlad:

    Возникла такая проблема:Программа 1С Предприятие перестала читать формат xls и xlsx, и теперь видит только txt,пожалуйста подскажите как зделать так чтобы программа опять видела xls и xlsx ?

  4. Виктория:

    Добрый день!
    Подскажите, пожалуйста, как открыть файлы с определёнными именами с помощью цикла? Например, file1, file2, file3 и т.д.

  5. Леон:

    Чтобы скопировать тексты приведенных программ можно выделить весь текст (Ctrl+A), вставить в текстовой редактор, а оттуда уж выдрать нужное ;)

    • Леон, куда проще навести мышкой на код, в строке меню для окна кода выбрать "Показать код в новом окне" и уже там Ctrl+A. Скопируется вообще только нужное :-)

      • Дима:

        как вариант: в окне с кодом при наведении мышкой на него появляется строка с кнопками, там есть кнопка Copy, щелкнуть по ней, затем нажать комбинацию ctrl+c

  6. Сергей:

    очень полезный код, очень мне помог. скажите, как можно ограничить файлы, которые открываются при работе этого кода датой создания? например только вчерашние...

    • Про какой именно код идет речь не знаю(только в папке или включая подпапки), но для открытия только вчерашних надо проверять дату последнего сохранения файла перед открытием. Что-то вроде:

      If format(FileDateTime(sFolder & sFiles),"yyyymmdd")=format(date-1,"yyyymmdd") then
          'открываем файл
          Workbooks.Open sFolder & sFiles
      end if
  7. Павел:

    Суперрешение! (первый макрос в статье) - универсально для большинства задач по работе (крупный банк). Помогло автоматизировать часть банковского процесса, которая выполнялась вручную и отнимало массу драгоценного рабочего времени. Спасибо автору!

  8. Алексей:

    Спасибо большое за код, который помог автоматизировать процесс!
    Но есть одна непонятность или ошибка...

    В папке есть файлы с названиями функций в таком порядке:
    ERROR_TYPE.xlsx
    INFO.xlsx
    ISEVEN.xlsx
    ISLOGICAL.xlsx
    ISNONCONTEXT.xlsx
    ISODD.xlsx
    N.xlsx
    TYPE.xlsx
    Код макроса оставлен без изменений, действия над файлом роли не играют.
    For Each objFile In objFolder.Files
    If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like strTypeOfFile Then
    Workbooks.Open sPath & objFile.Name
    Проблема в том, что последние 2 файла (N и TYPE) не обрабатываются.
    В дебаге вижу в objFile попадает правильное название файла N.xlsx и путь к нему, но фактически открывается файл ISEVEN.xlsx.
    Попробовал оставить только эти два файла - отрабатывает без проблем.
    Не могу понять закономерности, где может быть ошибка?

    • Алексей, никаких причин подобного поведения не вижу. Скорее всего проблема не в коде, раз значения в переменных правильные. Может быть книги открываются верные, но в скрытом режиме?

      • Алексей:

        Проблем действительно не в коде, но очень странная.
        При открытии проблемных файлов его имя в шапке документа изменяется. Так происходит не со всеми файлами, а только с некоторыми, закономерность непонятна. И в разных папках тоже есть подобные файлы.
        Теперь понятно, почему скрипт не отработал на них - у них просто такое же имя, как и у файлов, уже присутствующих в папке.
        И это происходит только на виртуальной машине с подкюченной папкой с этими файлами. На реальной машине имя файлов не меняется.

  9. Александр:

    Доброе время суток Дмитрий, подскажите в чем причина такого поведения. Нужно перебрать все файлы расширения xls , но даже если поменять
    sFiles = Dir(sFolder & "*.xls*")
    sFiles = Dir(sFolder & "*.xls") все равно и xls и, xlsx и, xlsm и, xlsb.
    Благодарю за внимание!

  10. Анна:

    Спасибо огромное! Это макрос просто супер!

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти