Vba excel получить список файлов в папке

Список файлов в папке

Иногда бывает необходимо заполучить на лист Excel список файлов в заданной папке и ее подпапках. В моей практике такое встречалось неоднократно, например:

• перечислить в приложении к договору на проведение тренинга список файлов из раздаточных материалов для особо щепетильных юристов в некоторых компаниях
• создать список файлов для ТЗ проекта
• сравнить содержимое папок (оригинал и бэкап, например)

Для реализации подобной задачи можно использовать несколько способов.

Способ 1. Скелет из шкафа — функция ФАЙЛЫ

Этот способ использует древнюю функцию ФАЙЛЫ (FILES), оставшуюся в Microsoft Excel с далеких девяностых. Вы не найдете эту функцию в общем списке функций, но для совместимости, она всё ещё остаётся внутри движка Excel, и мы вполне можем её использовать.

Механизм таков:

1. В любую ячейку листа (например, в А1) введём путь к папке, список файлов из которой мы хотим получить.

Обратите внимание, что путь должен оканчиваться шаблоном со звездочками:

• *.* — любые файлы
• *.xlsx — книги Excel (только с расширением xlsx)
• *.xl* — любые файлы Excel
• *отчет* — файлы, содержащие слово отчет в названии

и т.д.

2. Создадим именованный диапазон с помощью вкладки Формулы — далее кнопка Диспетчер имен — Создать (Formulas — Names Manger — Create). В открывшемся окне введем любое имя без пробелов (например Мои_файлы) и в поле диапазона выражение:

=ФАЙЛЫ(Лист1!$A$1)

После нажатия на ОК будет создан именованный диапазон с именем Мои_файлы, где хранится список всех файлов из указанной в А1 папки. Останется их оттуда только извлечь.

3. Чтобы извлечь имена отдельных файлов из созданной переменной, используем функцию ИНДЕКС (INDEX), которая в Excel вытаскивает данные из массива по их номеру:

Если лениво делать отдельный столбец с нумерацией, то можно воспользоваться костылем в виде функции СТРОКИ (ROWS), которая будет подсчитывать количество заполненных строк с начала списка автоматически:

=ИНДЕКС(Мои_файлы; ЧСТРОК($B$3:B3))

Ну, и скрыть ошибки #ССЫЛКА! в конце списка (если вы протягиваете формулу с запасом) можно стандартной функцией ЕСЛИОШИБКА (IFERROR):

=ЕСЛИОШИБКА(ИНДЕКС(Мои_файлы; ЧСТРОК($B$3:B3)); «»)

Важное примечание: формально функция ФАЙЛЫ относится к макро-функциям, поэтому необходимо будет сохранить ваш файл в формате с поддержкой макросов (xlsm или xlsb).

Способ 2. Готовый макрос для ленивых

Если вы знакомы с макросами (не в смысле их программирования, а в смысле копипастинга готовых кодов на VBA), то вам, возможно, отлично зайдёт небольшой макрос, добавляющий в текущую книгу новый пустой лист и выводящий на него список всех файлов с их параметрами из заданной пользователем папки.

Для добавления макроса в вашу книгу нажмите сочетание клавиш Alt+F11, или кнопку Visual Basic на вкладке Разработчик (Developer), в открывшемся окне редактора Visual Basic вставьте новый модуль через меню Insert — Module и скопируйте туда текст этого макроса:

Sub FileList()
    Dim V As String
    Dim BrowseFolder As String
    
    'открываем диалоговое окно выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
    
    'добавляем лист и выводим на него шапку таблицы
    ActiveWorkbook.Sheets.Add
    With Range("A1:E1")
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A1").Value = "Имя файла"
    Range("B1").Value = "Путь"
    Range("C1").Value = "Размер"
    Range("D1").Value = "Дата создания"
    Range("E1").Value = "Дата изменения"
    
    'вызываем процедуру вывода списка файлов
    'измените True на False, если не нужно выводить файлы из вложенных папок
    ListFilesInFolder BrowseFolder, True
End Sub


Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim r As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)

    r = Range("A65536").End(xlUp).Row + 1   'находим первую пустую строку
    'выводим данные по файлу
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Name
        Cells(r, 2).Formula = FileItem.Path
        Cells(r, 3).Formula = FileItem.Size
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 5).Formula = FileItem.DateLastModified
        r = r + 1
        X = SourceFolder.Path
    Next FileItem
    
    'вызываем процедуру повторно для каждой вложенной папки
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Columns("A:E").AutoFit

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

End Sub

Для запуска макроса нажмите сочетание клавиш Alt+F8,или кнопку Макросы (Macros) на вкладке Разработчик (Developer), выберите наш макрос FileList и нажмите кнопку Выполнить (Run). В диалоговом окне выберите любую папку или диск и — вуаля!

Если захотите, чтобы вместо пути к файлу в столбце B выводилась живая гиперссылка, то замените 52-ю строку

Cells(r, 2).Formula = FileItem.Path

на

Cells(r, 2).Formula = «=HYPERLINK(«»» & FileItem.Path & «»»)»

Способ 3. Мощь и красота — надстройка Power Query

Power Query — это очень мощная и при этом бесплатная надстройка для Excel от Microsoft, упрощающая множество задач по загрузке и трансформации данных. В нашей ситуации она тоже может здорово помочь.

Если у вас Excel 2016 или новее, то Power Query уже встроена в Excel по умолчанию, поэтому просто на вкладке Данные выберите команду Создать запрос / Получить данные — Из файла — Из папки (Create Query / Get Data — From file — From folder). Если у вас Excel 2010-2013, то Power Query нужно будет скачать с сайта Microsoft и установить как отдельную надстройку и она появится у вас в Excel в виде отдельной вкладки Power Query. На ней будет аналогичная кнопка Из файла — Из папки (From file — From folder).

В открывшемся окне нужно будет указать папку, содержимое которой мы хотим получить. После нажатия на ОК Power Query обшарит указанную папку и все вложенные подпапки и выдаст на экран окно с предварительным просмотром результатов:

Если внешний вид списка вас устраивает, то можно смело жать внизу кнопку Загрузить (Load), чтобы залить эти данные на новый лист. Если же хочется дополнительно обработать список (удалить лишние столбцы, отобрать только нужные файлы и т.п.), то нужно выбрать команду Изменить / Преобразовать данные (Edit / Transform Data).

Поверх окна Excel откроется окно редактора Power Query, где мы увидим список всех наших файлов в виде таблицы:

Дальше возможны несколько вариантов:

• Если нужны только файлы определенного типа, то их можно легко отобрать с помощью фильтра по столбцу Extension:

  

• Аналогичным образом фильтрами по столбцам Date accessed, Date modified или Date created можно отобрать файлы за нужный период (например, созданные только за последний месяц и т.п.):

  

• Если нужно получить данные не из всех папок, то фильтруем по столбцу Folder Path, чтобы оставить только те строки, где путь содержит/не содержит нужные имена папок:

  
• Там же можно выполнить сортировку файлов по любому столбцу, если требуется.

После того, как необходимые файлы отобраны, можно смело удалить ненужные столбцы, щелкнув по заголовку столбца правой кнопкой мыши и выбрав команду Удалить (Remove column). Это, кстати, уже никак не повлияет на фильтрацию или сортировку нашего списка:

Если в будущем планируется подсчитывать количество файлов в каждой папке (например, для контроля поступивших заявок или подсчета статистики по заявкам), то имеет смысл дополнительно сделать ещё пару действий:

• Щелкните правой кнопкой мыши по столбцу Folder Path и выберите команду Дублировать столбец (Duplicate Column).
• Выделите скопированный столбец и на вкладке Преобразование (Transform) выберите Разделить столбец — По разделителю (Split Column — By delimiter)

Мы получим рядом с нашими данными еще несколько столбцов, где будут продублированы имена вложенных папок — это пригодится нам чуть позже для подсчета статистики с помощью сводной таблицы:

Получившиеся столбцы можно переименовать (Диск, Папка1, Папка2 и т.д.), просто щёлкнув дважды по заголовку каждого.

И, наконец, когда список готов, то его можно выгрузить на лист с помощью команды Главная — Закрыть и загрузить — Закрыть и загрузить в… (Home — Close & Load — Close & Load to…):

Дополнительным бонусом можно сделать еще один столбец с функцией ГИПЕРССЫЛКА (HYPERLINK), которая создаст красивые стрелочки-ссылки для моментального перехода к каждому файлу:

Мелочь, а приятно

И вдвойне приятно, что в будущем, при изменении содержимого исходной папки, достаточно будет просто щелкнуть мышью по нашей таблице и выбрать команду Обновить (Refresh) — и Power Query выполнит всю цепочку запрограммированных нами единожды действий уже автоматически, отобразив все изменения в составе папки.

Ссылки по теме

• Что такое макрос, куда вставлять код макроса на Visual Basic
• Создание резервных копий ценных файлов
• Что такое Power Query и что можно делать с её помощью

Файлы к уроку:

• Для спонсоров Boosty
• Для спонсоров VK

• YouTube
• VK

Описание

Создадим макросы, которые выводят на листах Excel списки всех файлов в папке, папок и файлов внутри папок.

Решение

Список всех файлов внутри папки

' Перечень файлов внутри папки
Sub get_file_names()

    Dim objFSO As Object        ' В этой переменной будет объект FileSystemObject
    Dim objFolder As Object     ' В этой переменной будет объект Folder
    
    ' Получаем доступ к файловой системе компьютера
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Создаем объект Folder
    Set objFolder = objFSO.GetFolder("c:Userstimur.kryukovDownloadscomrade.excel ideasVBA. Практика. Список всех файлов в папкеDirectory")
    
    ' Строка для вывода
    row = 2
    
    ' Цикл по каждому файлу в папке
    For Each file In objFolder.Files
        ' Имя файла
        Cells(row, 1) = file.Name
        ' Путь к папке
        Cells(row, 2) = objFolder
        ' Переход на следующую строку
        row = row + 1
    Next file
    
    ' Автоподбор ширины
    Columns("A").EntireColumn.AutoFit

End Sub

Список всех папок внутри папки

' Перечень папок внутри папки
Sub get_subfolder_names()

    Dim objFSO As Object
    Dim objFolder As Object
    
    ' Получаем доступ к файловой системе компьютера
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Создаем объект Folder
    Set objFolder = objFSO.GetFolder("c:Userstimur.kryukovDownloadscomrade.excel ideasVBA. Практика. Список всех файлов в папкеDirectory")
    
    ' Строка для вывода
    row = 2
    
    ' Цикл по каждой папке в папке
    For Each folder In objFolder.subfolders
        ' Вывод имени файла
        Cells(row, 1) = folder.Name
        ' Путь к папке
        Cells(row, 2) = folder.Path
        ' Переход на следующую строку
        row = row + 1
    Next folder
    
    ' Автоподбор ширины
    Columns("A").EntireColumn.AutoFit
    
End Sub

Список всех файлов в папке, папок и файлов внутри папок

' Перечень папок и файлов внутри них
Sub get_subfolder_and_file_names()

    Dim objFSO As Object
    Dim objFolder As Object
    
    ' Получаем доступ к файловой системе компьютера
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Создаем объект Folder
    Set objFolder = objFSO.GetFolder("c:Userstimur.kryukovDownloadscomrade.excel ideasVBA. Практика. Список всех файлов в папкеDirectory")
    
    ' Строка для вывода
    row = 2
    
    ' Цикл по каждой папке
    For Each subfolder In objFolder.subfolders
        ' Цикл по каждому файлу
        For Each file In subfolder.Files
            ' Имя папки
            Cells(row, 1) = subfolder.Name
            ' Имя файла
            Cells(row, 2) = file.Name
            ' Путь к файлу/папке
            Cells(row, 3) = file.Path
            ' Переход на следующую строчку
            row = row + 1
        Next file
    Next subfolder
    
    For Each file In objFolder.Files
        ' Имя папки
        Cells(row, 1) = objFolder.Name
        ' Имя файла
        Cells(row, 2) = file.Name
        ' Путь к файлу
        Cells(row, 3) = file.Path
        ' Переход на следующую строчку
        row = row + 1
    Next file
    
End Sub

Примененные функции

• .GetFolder
• Cells
• CreateObject
• For Each
• Scripting.FileSystemObject

You can use the built-in Dir function or the FileSystemObject.

• Dir Function: VBA: Dir Function

• FileSystemObject: VBA: FileSystemObject — Files Collection

They each have their own strengths and weaknesses.

Dir Function

The Dir Function is a built-in, lightweight method to get a list of files. The benefits for using it are:

• Easy to Use
• Good performance (it’s fast)
• Wildcard support

The trick is to understand the difference between calling it with or without a parameter. Here is a very simple example to demonstrate:

Public Sub ListFilesDir(ByVal sPath As String, Optional ByVal sFilter As String)

    Dim sFile As String

    If Right(sPath, 1) <> "" Then
        sPath = sPath & ""
    End If

    If sFilter = "" Then
        sFilter = "*.*"
    End If

    'call with path "initializes" the dir function and returns the first file name
    sFile = Dir(sPath & sFilter)

   'call it again until there are no more files
    Do Until sFile = ""

        Debug.Print sFile

        'subsequent calls without param return next file name
        sFile = Dir

    Loop

End Sub

If you alter any of the files inside the loop, you will get unpredictable results. It is better to read all the names into an array of strings before doing any operations on the files. Here is an example which builds on the previous one. This is a Function that returns a String Array:

Public Function GetFilesDir(ByVal sPath As String, _
    Optional ByVal sFilter As String) As String()

    'dynamic array for names
    Dim aFileNames() As String
    ReDim aFileNames(0)

    Dim sFile As String
    Dim nCounter As Long

    If Right(sPath, 1) <> "" Then
        sPath = sPath & ""
    End If

    If sFilter = "" Then
        sFilter = "*.*"
    End If

    'call with path "initializes" the dir function and returns the first file
    sFile = Dir(sPath & sFilter)

    'call it until there is no filename returned
    Do While sFile <> ""

        'store the file name in the array
        aFileNames(nCounter) = sFile

        'subsequent calls without param return next file
        sFile = Dir

        'make sure your array is large enough for another
        nCounter = nCounter + 1
        If nCounter > UBound(aFileNames) Then
            'preserve the values and grow by reasonable amount for performance
            ReDim Preserve aFileNames(UBound(aFileNames) + 255)
        End If

    Loop

    'truncate the array to correct size
    If nCounter < UBound(aFileNames) Then
        ReDim Preserve aFileNames(0 To nCounter - 1)
    End If

    'return the array of file names
    GetFilesDir = aFileNames()

End Function

File System Object

The File System Object is a library for IO operations which supports an object-model for manipulating files. Pros for this approach:

• Intellisense
• Robust object-model

You can add a reference to to «Windows Script Host Object Model» (or «Windows Scripting Runtime») and declare your objects like so:

Public Sub ListFilesFSO(ByVal sPath As String)

    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim oFile As File

    Set oFSO = New FileSystemObject
    Set oFolder = oFSO.GetFolder(sPath)
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next 'oFile

    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

End Sub

If you don’t want intellisense you can do like so without setting a reference:

Public Sub ListFilesFSO(ByVal sPath As String)

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next 'oFile

    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

End Sub

Список файлов в папке

​Смотрите также​ .Font.Bold = True​ и создать из​: Что за файлы?​ As String, ByVal​ тренинга список файлов​ вникать в синтаксис([/SIZE]​

• ​: Нужно получить названия​ False, если не​ заданной папке и​i = i + 1​На VB данная​а для​ в моем коде​
• ​ Folders.​на​
• ​ Range(«E1»).Value = «Дата​Иногда бывает необходимо заполучить​

​ .Font.Size = 12​ них коллекцию?​ Чем открывать?​ IncludeSubfolders As Boolean)​ из раздаточных материалов​ sFiles = Dir​ файлов в заданной​ нужно выводить файлы​ ее подпапках. В​iFileName$ = Dir​ стандартная функция, по-моему,​

​Shell​ она все равно​KoGG​​Cells(r, 2).Formula = «=HYPERLINK(«»»​​ изменения» ‘вызываем процедуру​ на лист Excel​ End With Range(«A1»).Value​GafarovIS​​shavka​​ Dim FSO As​ для особо щепетильных​

​ Loop Application.ScreenUpdating =​ директории и записать​ из вложенных папок​ моей практике такое​Loop​ ещё проще и​и т.п. необходимо…​ выводит в т.ч.​, а строку 11​ & FileItem.Path &​ вывода списка файлов​ список файлов в​ = «Имя файла»​: а для Access​: файлы csv. В​ Object Dim SourceFolder​ юристов в некоторых​ True End Sub​ их в динамический​ ListFilesInFolder BrowseFolder, True​ встречалось неоднократно, например:​End Sub​ понятнее. ИМХО…​Smith&Wesson​ имена файлов.​ лучше перенести в​ «»»)»​ ‘измените True на​ заданной папке и​ Range(«B1»).Value = «Путь»​ какой код будет​ екселе нужно открыть​ As Object Dim​ компаниях​Sam_nit​ массив, недавно начал​ End Sub Private​перечислить в приложении к​всего не читал​Может не прав,​: А зачем так​И еще вопрос:​ позицию № 5,​vova_net​ False, если не​ ее подпапках. В​ Range(«C1»).Value = «Размер»​ правильным?​ автоматически. В МО2003​ SubFolder As Object​создать список файлов для​: Помогите в вышестоящий​ изучать VBA, и​ Sub ListFilesInFolder(ByVal SourceFolderName​ договору на проведение​ — только название​ но всегда считал,​ все сложно, когда​ написано, что нужно​ т.к. при задании​: Подскажите как получить​ нужно выводить файлы​ моей практике такое​ Range(«D1»).Value = «Дата​GafarovIS​ работал такой код:​ Dim FileItem As​ ТЗ проекта​ код впихнуть массив​ не могу придумать​ As String, ByVal​ тренинга список файлов​ темы…​ чем проще и​ можно использовать объект​ ставить двойные кавычки​ несуществующего диска выбьет​ список папок в​

​ из вложенных папок​ встречалось неоднократно, например:​​ создания» Range(«E1»).Value =​​: Тебе имена файлов​​Dim s As​​ Object Dim r​​сравнить содержимое папок (оригинал​​ Dir names() As​ как это сделать.​ IncludeSubfolders As Boolean)​ из раздаточных материалов​

​gling​ меньше код -​ Enumerator​ Chr(34), если в​ ошибку на строке​ заданной директории (при​

​ ListFilesInFolder BrowseFolder, True​

​перечислить в приложении к​

​ «Дата изменения» ‘вызываем​ получить или открыть​ String s =​

planetaexcel.ru

Как получить список папок в заданной директории

​ As Long Set​​ и бэкап, например)​ String ))​KuklP​ Dim FSO As​ для особо щепетильных​: Есть вариант, макросы​

​ тем лучше.​​Javascript var FSO,F,SFold,SubFolders,s;​ имени папки есть​ 7.​ этом имена файлов​ End Sub Private​ договору на проведение​ процедуру вывода списка​ все файлы?​ Dir(«C:Documents and SettingsKoltsovaМои​ FSO = CreateObject(«Scripting.FileSystemObject»)​Для реализации подобной задачи​KuklP​: Читать форум. Примеров​ Object Dim SourceFolder​ юристов в некоторых​ от разных производителей,​cherkas​ FSO=WScript.CreateObject(«Scripting.FileSystemObject»); //Путь к​ пробелы. Но у​Апострофф​ в список попадать​ Sub ListFilesInFolder(ByVal SourceFolderName​ тренинга список файлов​

​ файлов ‘измените True​​нужно получить в​
​ документыBOON*.csv») ‘ Application.Workbooks.Open​ Set SourceFolder =​ отлично подойдет небольшой​:​ полно, поиск работает.​ As Object Dim​ компаниях​ объединенных в одном​: Здравствуйте знатоки! Есть​ каталогу SFold=»C:\Program Files»;​ меня все работает​: А можно и​ не должны)?​ As String, ByVal​ из раздаточных материалов​ на False, если​ таблицу. но как​ (s) Do While​ FSO.getfolder(SourceFolderName) r =​ макрос, добавляющий в​Sam_nit​Sam_nit​ SubFolder As Object​создать список файлов для​ файле. Может и​ одна проблема и​ s=»Каталог «+SFold+»n»; s+=»Подкаталоги:n»;​ и без них.​ стандартными VB-средствами обойтись​KoGG​ IncludeSubfolders As Boolean)​ для особо щепетильных​
​ не нужно выводить​​ я понимаю, сперва​ s <> «​ Range(«A65536»).End(xlUp).Row + 1​ текущую книгу новый​: ии??​: Пытался пользоваться поиском,​ Dim FileItem As​

​ ТЗ проекта​​ вам пригодится. Для​ как решить пока​ //Создаем объект Folder​ И наоборот ничего​ Option Explicit Function​: Dim Folders() As​ Dim FSO As​ юристов в некоторых​ файлы из вложенных​ нужно в массив,​ » s =​ ‘находим первую пустую​ пустой лист и​The_Prist​ нужного не обнаружил.​ Object Dim r​сравнить содержимое папок (оригинал​ включения в список,​ не придумал, решил​ для каталога C:Program​ не выдает/работает неверно,​ Get_DirS(path As String)​ String Sub Subfolders_in(Folder$)​ Object Dim SourceFolder​ компаниях​ папок ListFilesInFolder BrowseFolder,​ а потом из​
​ Dir Application.Workbooks.Open (s)​ строку ‘выводим данные​ выводящий на него​: Что и? Вам​ Мне нужен конкретный​ As Long Set​ и бэкап, например)​

​ содержимого под папок,​​ получить консультацию.​​ Files F=FSO.GetFolder(SFold); //Создаем​​ если их указать.​ Dim a() As​ Dim N% Dim​ As Object Dim​создать список файлов для​ True End Sub​
​ массива в таблицу?​ On Error Resume​ по файлу For​ список всех файлов​ дали конкретный кусок​ кусок кода, где​ FSO = CreateObject(«Scripting.FileSystemObject»)​Для реализации подобной задачи​ необходимо указать на​Суть:​
​ коллекцию подкаталогов каталога​Казанский​ String, D As​ fs, f, f1,​ SubFolder As Object​ ТЗ проекта​ Private Sub ListFilesInFolder(ByVal​Dim MyFileName$ Private​ Next Loop End​
​ Each FileItem In​ с их параметрами​ кода для перебора​ путь прописывается в​ Set SourceFolder =​ отлично подойдет небольшой​любой документ​Есть несколько папок​ C:Program Files SubFolders=​: А что бы​ String, U As​

​ fc Set fs​​ Dim FileItem As​сравнить содержимое папок (оригинал​ SourceFolderName As String,​ Sub Кнопка0_Click() DoCmd.SetWarnings​ SubВ МО10 пишет:​
​ SourceFolder.Files Cells(r, 1).Formula​ из заданной пользователем​ файлов в папке.​ ручную. А не​ FSO.getfolder(SourceFolderName) r =​ макрос, добавляющий в​вне этих папок​ с фотографиями. Фотографий​ new Enumerator(F.SubFolders); //Цикл​ в список попали​ Long D =​ = CreateObject(«Scripting.FileSystemObject») Set​ Object Dim r​
​ и бэкап, например)​ ByVal IncludeSubfolders As​ False DoCmd.RunSQL «Delete​ никак не найду​ = FileItem.Name Cells(r,​
​ папки вот такого,​ Готовый макрос Вам​ готовый макрос.​ Range(«A65536»).End(xlUp).Row + 1​ текущую книгу новый​ (рядом с этими​ в папках около​​ по всем подкаталогам​​ всякие с причудами​ Dir(path, vbDirectory) While​ f = fs.GetFolder(Folder)​
​ As Long Set​Для реализации подобной задачи​ Boolean) Dim FSO​
​ Файлы.Файл FROM Файлы;»​
​ файл с именем​ 2).Formula = FileItem.Path​ примерно, вида:​ был НЕ НУЖЕН​Hugo​​ ‘находим первую пустую​​ пустой лист и​
​ папками). Думаю разберетесь.​
​ 30 000 шт.​ for (; !SubFolders.atEnd();​
​ директории, можно написать​ D <> «»​​ Set fc =​​ FSO = CreateObject(«Scripting.FileSystemObject»)​
​ отлично подойдет небольшой​​ As Object Dim​​ MyFileName = Dir(«D:ПользователиИльдарЗагрузки»)​

​ » » (?!,​​ Cells(r, 3).Formula =​Для добавления макроса в​ — сами написали.​:​
​ строку ‘выводим данные​ выводящий на него​ Здесь про список​ нужно в один​ SubFolders.moveNext()) { s+=SubFolders.item()+»n»;​ так -​ If GetAttr(path &​ f.SubFolders N =​ Set SourceFolder =​ макрос, добавляющий в​ SourceFolder As Object​ Do Until MyFileName​ издевается наверное). Runtime​ FileItem.Size Cells(r, 4).Formula​ вашу книгу нажмите​ Так вот изучайте,​Sam_nit​ по файлу For​ список всех файлов​Alex_ST​

​ столбец excel получить​​ //Добавляем строку с​D = Dir(path,​ «» & D)​ 0 On Local​ FSO.getfolder(SourceFolderName) r =​​ текущую книгу новый​​ Dim SubFolder As​ = «» DoCmd.RunSQL​ error 1004​ = FileItem.DateCreated Cells(r,​ сочетание клавиш​ меняйте, дорабатывайте под​: все равно не​
​ Each FileItem In​ с их параметрами​: Хоть уже и​ названия всех этих​ именем подкаталога }​ vbDirectory Or vbHidden​ And vbDirectory Then​ Error Resume Next​ Range(«A65536»).End(xlUp).Row + 1​ пустой лист и​ Object Dim FileItem​ «INSERT INTO Файлы​Есть еще метод​ 5).Formula = FileItem.DateLastModified​ALT+F11​ свои нужды самостоятельно.​ совсем то, тем​ SourceFolder.Files Cells(r, 1).Formula​ из заданной пользователем​ не нужно, наверное…​ файлов, а во​ //Выводим полученные строки​
​ Or vbSystem) While​ ReDim Preserve a(U)​ For Each f1​ ‘находим первую пустую​
​ выводящий на него​ As Object Dim​ ( Файл )​ из диалогового окна:​
​ r = r​, в открывшемся окне​ Как и просили.​ более ругается на​ = FileItem.Name Cells(r,​

CyberForum.ru

получить список файлов из папки (Иное/Other)

​ папки вот такого,​​Но готовый файл​ второй столбец название​ на экран WScript.Echo(s);P.S.​ D <> «»​ a(U) = path​
​ In fc N​
​ строку ‘выводим данные​ список всех файлов​ r As Long​ SELECT ‘» &​Sub OpenFiles() ‘Открытие​ + 1 X​ редактора Visual Basic​Sam_nit​ метод:​ 2).Formula = FileItem.Path​ примерно, вида:​ ЗДЕСЬ всё-таки посмотрите.​ папки из которой​
​ код не мой,​ If GetAttr(path &​ & D U​ = N +​ по файлу For​
​ с их параметрами​ Set FSO =​
​ MyFileName & «‘;»​ файлов из папки​ = SourceFolder.Path Next​ вставьте новый модуль​: Там было такоее​Function FilenamesCollection(ByVal FolderPath​ Cells(r, 3).Formula =​Для добавления макроса в​ Может пригодиться. У​ эта фотография. Если​ но всегда пользуюсь​ «» & D)​ = U +​ 1 ReDim Preserve​

​ Each FileItem In​​ из заданной пользователем​​ CreateObject("Scripting.FileSystemObject") Set SourceFolder​
​ MyFileName = Dir​
​ c загрузкой в​ FileItem 'вызываем процедуру​
​ через меню​ маааленькое слово "путь"​
​ As String, Optional​ FileItem.Size Cells(r, 4).Formula​
​ вашу книгу нажмите​
​ меня на работе​ это имеет значение,​
​ им, как шаблоном​
​ And vbDirectory And​ 1 End If​
​ Folders(1 To N)​ SourceFolder.Files Cells(r, 1).Formula​
​ папки вот такого,​
​ = FSO.getfolder(SourceFolderName) r​
​ Loop DoCmd.SetWarnings True​
​ браузер вручную a​

​ повторно для каждой​Insert — Module​ он же путь​

​ ByVal Mask As​​ = FileItem.DateCreated Cells(r,​ сочетание клавиш​ многие им пользуются​ то названия кириллицей.​Smith&Wesson​ D <> «.»​ D = Dir​ As String Folders(N)​​ = FileItem.Name Cells(r,​​ примерно, вида:​ = Range(«A65536»).End(xlUp).Row +​ End Sub​ = Application.GetOpenFilename(«Text Files​

​ вложенной папки If​​и скопируйте туда​ к папке. Собственно​
​ String = «»,​ 5).Formula = FileItem.DateLastModified​ALT+F11​sjerj​Возможно ли как​

excelworld.ru

Список файлов из папки.

​, в посте #2​​ And D <>​ Wend Get_DirS =​
​ = Folder &​ 2).Formula = FileItem.Path​Для добавления макроса в​ 1 ‘находим первую​GafarovIS​ (*.csv), *.csv», MultiSelect:=True)​ IncludeSubfolders Then For​ текст этого макроса:​ я имел в​
​ _​ r = r​

​, в открывшемся окне​​: Доброго времени суток​ то осуществить такое​ то же самое,​ «..» Then ‘далее​ a End Function​ «» & f1.Name​ Cells(r, 3).Formula =​ вашу книгу нажмите​ пустую строку ‘выводим​, это рабочий код​ End SubНо мне​ Each SubFolder In​Sub FileList() Dim​ виду только это.​Optional ByVal SearchDeep​ + 1 X​ редактора Visual Basic​ уважаемые форумчане.​ и если возможно​ только на другом​

​ по текстуУпсс: Это​​ Sub Get_DirS_Example() Dim​

CyberForum.ru

Список файлов в папке

​ & «» Next​ FileItem.Size Cells(r, 4).Formula​ сочетание клавиш​ данные по файлу​ ?да, у меня​ реально ничего не​ SourceFolder.SubFolders ListFilesInFolder SubFolder.Path,​

• ​ V As String​ А не то​ As Long =​ = SourceFolder.Path Next​ вставьте новый модуль​Возник вопрос, как​ помогите кто чем​
• ​ языке, и результат​ была добавка к​
• ​ a a =​ f1 End SubСписок​

​ = FileItem.DateCreated Cells(r,​ALT+F11​ For Each FileItem​ работает. Access 2017​ хоцца делать вручную​ True Next SubFolder​ Dim BrowseFolder As​ что вроде бы​ 999) As Collection​ FileItem ‘вызываем процедуру​ через меню​

​ методами VBA WORD,​ может.​ в массиве.​​ четвёртому посту.​​ Get_DirS(«C:Documents and Settings»)​ с полными путями​ 5).Formula = FileItem.DateLastModified​, в открывшемся окне​​ In SourceFolder.Files Cells(r,​​без дополнительных библиотек​Проблема в том,​

​ End If Columns(«A:E»).AutoFit​ String ‘открываем диалоговое​ в макросе перебор​method or data​ повторно для каждой​Insert — Module​ в textbox на​За ранее всем​Smith&Wesson​На уровне подсознания​ End SubПричем работают​ в массиве Folders()​ r = r​ редактора Visual Basic​ 1).Formula = FileItem.Name​Добавлено через 44 секунды​ что я никак​ Set FileItem =​ окно выбора папки​ есть, но выполняет​ member not found​ вложенной папки If​и скопируйте туда​ форме, при нажатии​ спасибо.​, вы ошиблись разделом​ я понимаю эту​ они зачастую быстрее​Апострофф​ + 1 X​ вставьте новый модуль​ Cells(r, 2).Formula =​нужна таблица «Файлы»​ не могу грамотно​ Nothing Set SourceFolder​ With Application.FileDialog(msoFileDialogFolderPicker) .Title​ он не то​The_Prist​ IncludeSubfolders Then For​ текст этого макроса:​ кнопки, вывести список​PS как получать​ форума. Здесь обсуждается​ фишку, но сомневаюсь,​ стронних библиотек.​: Вариант:​ = SourceFolder.Path Next​ через меню​ FileItem.Path Cells(r, 3).Formula​ с полем «Файл»​ написать цикл, а​ = Nothing Set​ = «Выберите папку​ что нужно. Доработать​:​ Each SubFolder In​Sub FileList() Dim​ файлов находящихся в​ мне не принципиально,​ язык программирования VBA.Только​ сумею ли внятно​If GetAttr(myPath &​Sub Dirs() Dim​ FileItem ‘вызываем процедуру​Insert — Module​ = FileItem.Size Cells(r,​nwcop​ без цикла не​ FSO = Nothing​ или диск» .Show​ можно, но знаний​Sam_nit​ SourceFolder.SubFolders ListFilesInFolder SubFolder.Path,​ V As String​ определенной папке? Все​ если получиться сделать​ заметил, что ветка​ объяснить​

​ myName) = vbDirectory​ myName$, myPath$, N%,​​ повторно для каждой​​и скопируйте туда​​ 4).Formula = FileItem.DateCreated​​: Доброго времени суток​​ обойтись — кол-во​​ End Sub​ On Error Resume​ моих не хватит,​: Таак, насколько я​

​ True Next SubFolder​ Dim BrowseFolder As​ файлы имеют одинаковое​ по одной папке​ по VBA В​Но попробую- Dir​

​ And myName <>​

​ Folders$() On Local​

​ вложенной папки If​ текст этого макроса:​ Cells(r, 5).Formula =​

planetaexcel.ru

VBA Список названий файлов из директории в массив

​ ВСЕМ! Возможно ли​​ файлов в папке​Для запуска макроса нажмите​ Next Err.Clear V​ собственно помощь в​ понял,​ End If Columns(«A:E»).AutoFit​ String ‘открываем диалоговое​ расширение.​

​ и получать только​​ таком случае, функция​ ищет по сумме​

​ «.» And myName​​ Error Resume Next​ IncludeSubfolders Then For​Sub FileList() Dim​ FileItem.DateLastModified r =​ изменить Код, что​ всегда будет меняться.​ сочетание клавиш​

​ = .SelectedItems(1) If​​ этом я и​

​Sub Get_All_File_from_Folder() Dim​​ Set FileItem =​ окно выбора папки​Заранее спасибо за​ один столбец с​
​ будет следующая:​ аттрибутов, поэтому 0​ <> «..» ThenИ​ myPath = InputBox(«Введите​ Each SubFolder In​
​ V As String​ r + 1​ бы можно было​
​ Команды и функции,​ALT+F8​

​ Err.Number <> 0​​ просил​

​ sFolder As String,​​ Nothing Set SourceFolder​ With Application.FileDialog(msoFileDialogFolderPicker) .Title​
​ ответ.​ названиями фотографий, то​’Объявляем переменные Dim​ (vbNormal) на него​ так даже приходилось​ директорию», , «c:temp»)​ SourceFolder.SubFolders ListFilesInFolder SubFolder.Path,​ Dim BrowseFolder As​ X = SourceFolder.Path​ задавать период по​ которые здесь работают​, выберите наш макрос​ Then MsgBox «Вы​KuklP​ sFiles As String​ = Nothing Set​ = «Выберите папку​mc-black​ меня это тоже​ FSO, SFold, SubFolders,​ не влияет, что​ писать​ If Right(myPath, 1)​ True Next SubFolder​ String ‘открываем диалоговое​ Next FileItem ‘вызываем​ «по дате создания»,​ — их много.​FileList​ ничего не выбрали!»​: ЦитатаSam_nit пишет:​ With Application.FileDialog(msoFileDialogFolderPicker) If​

​ FSO = Nothing​​ или диск» .Show​: Private Sub CommandButton1_Click()​ устроит, папки я​ sFlds, tsOut ‘Создаем​

​ бы ни указали​​Smith&Wesson​

​ <> «» Then​​ End If Columns(«A:E»).AutoFit​

​ окно выбора папки​​ процедуру повторно для​ и в «Список​ Цикл должон быть​и нажмите кнопку​ Exit Sub End​Там было такоее​ .Show = False​ End Sub​ On Error Resume​ MyPath = «D:Документы»​ уж и сам​

​ объект FileSystemObject Set​​ в параметре​:​ myPath = myPath​ Set FileItem =​ With Application.FileDialog(msoFileDialogFolderPicker) .Title​ каждой вложенной папки​ файлов в папке»​ такой — добраться​Выполнить (Run)​ If End With​ маааленькое слово «путь»​ Then Exit Sub​Для запуска макроса нажмите​ Next Err.Clear V​ MyName = Dir(MyPath,​ тогда проставлю. Всё​ FSO = WScript.CreateObject(«Scripting.FileSystemObject»)​

​attributes​​Апострофф​
​ & «» If​ Nothing Set SourceFolder​ = «Выберите папку​ If IncludeSubfolders Then​ попали только файлы​ до папки и​. В диалоговом окне​
​ BrowseFolder = CStr(V)​ он же путь​ sFolder = .SelectedItems(1)​
​ сочетание клавиш​

​ = .SelectedItems(1) If​​ vbDirectory) Do While​

​ же быстрее чем​​ ‘Создаем файл, куда​

planetaexcel.ru

Список файлов в папке

​, поэтому и попадают​, да, я был​ Dir(Left(myPath, Len(myPath) -​ = Nothing Set​ или диск» .Show​ For Each SubFolder​ «по дате создания».​

• ​ все файлы которые​ выберите любую папку​ ‘добавляем лист и​ к папке. Собственно​ End With sFolder​ALT+F8​ Err.Number <> 0​
• ​ MyName <> «»​ 30 000 фото​
• ​ будем записывать имена​ в результат обычные​

​ не прав. vbDirectory=32,​ 1), 16) =​ FSO = Nothing​ On Error Resume​ In SourceFolder.SubFolders ListFilesInFolder​ Спасибо.​ там есть, пооткрывать.​ или диск и​ выводим на него​ я имел в​ = sFolder &​

​, выберите наш макрос​ Then MsgBox «Вы​ If MyName <>​​ руками вбивать.​​ подкаталогов Set tsOut​ (vbNormal) файлы.​ если папка в​ «» Then MsgBox​​ End Sub​​ Next Err.Clear V​ SubFolder.Path, True Next​

​Sub FileList() Dim​shavka​ — вуаля!​ шапку таблицы ActiveWorkbook.Sheets.Add​ виду только это.Да​ IIf(Right(sFolder, 1) =​FileList​ ничего не выбрали!»​ «.» And MyName​Nic70y​ = FSO.CreateTextFile(«output.txt», True,​А потому и​ корне и =​ «Папка не существует!»:​Для запуска макроса нажмите​ = .SelectedItems(1) If​ SubFolder End If​ V As String​: ПОПРОБУЙТЕ ТАК​Если захотите, чтобы вместо​ With Range(«A1:E1») .Font.Bold​ пожалуйста:​ Application.PathSeparator, «», Application.PathSeparator)​и нажмите кнопку​ Exit Sub End​ <> «..» Then​:​ False) ‘Путь к​ необходима дополнительная фильтрация…​ 16, если это​ Exit Sub myName​ сочетание клавиш​ Err.Number <> 0​ Columns(«A:E»).AutoFit Set FileItem​ Dim BrowseFolder As​SUB DIR131127() Dim​ пути к файлу​ = True .Font.Size​s = InputBox(«Ввведите​ Application.ScreenUpdating = False​Выполнить (Run)​ If End With​ If MyName Like​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub Workbook_Open()​ корневому каталогу SFold​ Вот(уж как сумел)​ подкаталог.​ = Dir(myPath, vbDirectory)​ALT+F8​ Then MsgBox «Вы​ = Nothing Set​ String With Application.FileDialog(msoFileDialogFolderPicker)​ s As String​ в столбце B​ = 12 End​ полный путь к​ sFiles = Dir(sFolder​. В диалоговом окне​ BrowseFolder = CStr(V)​ «*.txt» Then ‘​Columns(«A:A»).ClearContents​ = «C:Program Files»​Добавлено через 21 минуту​Эту строку ‘If​ Do While myName​, выберите наш макрос​ ничего не выбрали!»​ SourceFolder = Nothing​ .Title = «Выберите​ s = Dir(«C:Documents​ выводилась живая гиперссылка,​ With Range(«A1″).Value =​ папке», «Путь»)​ & «*.xls*») Do​ выберите любую папку​ ‘добавляем лист и​ Маска файлов с​Dim iPath As​

​ Set Folder =​То есть Dir(path,​​ GetAttr(path & «»​​ <> «» If​​FileList​​ Exit Sub End​​ Set FSO =​​ папку или диск»​ and SettingsKoltsovaМои документыBOON*.csv»)​ то замените 52-ю​ «Имя файла» Range(«B1»).Value​

​Вопрос исчерпан?​ While sFiles <>​ или диск и​ выводим на него​ нужным расширением ‘​ String​

​ FSO.GetFolder(SFold) ‘Цикл по​

​ vbDirectory Or vbNormal)и​

​ & D) And​ GetAttr(myPath & myName)​и нажмите кнопку​

planetaexcel.ru

Получить имена файлов в директории

​ If End With​​ Nothing End Sub​ .Show On Error​ »On Error Resume​ строку​ = «Путь» Range(«C1»).Value​

​Мотя​​ «» [QUOTE] ‘открываем​ — вуаля!​

​ шапку таблицы ActiveWorkbook.Sheets.Add​​ Вывод названий файлов​Dim iFileName As​ всем подкаталогам for​ Dir(path, vbDirectory)одно и​
​ vbDirectory Then’ я,​ = vbDirectory And​Выполнить (Run)​ BrowseFolder = CStr(V)​Казанский​ Resume Next Err.Clear​ Next Do While​Cells(r, 2).Formula = FileItem.Path​ = «Размер» Range(«D1»).Value​: Вариант.​ книгу Workbooks.Open sFolder​Если захотите, чтобы вместо​ With Range(«A1:E1») .Font.Bold​ в TextBox TextBox1.Text​ String​ Each SubFolder In​
​ тоже, с точки​ конечно, подсмотрел на​
​ myName <> «.»​. В диалоговом окне​ ‘добавляем лист и​: Dim d As​ V = .SelectedItems(1)​ LEN(s)>0 Application.Workbooks.Open («C:Documents​на​ = «Дата создания»​Sam_nit​
​ & sFiles ‘действия​ пути к файлу​ = True .Font.Size​ = TextBox1.Text &​Dim i As​ Folder.SubFolders sFlds =​ зрения​ MSDN, но нифига​ Then N =​ выберите любую папку​ выводим на него​ Date, d1 As​ If Err.Number <>​ and SettingsKoltsovaМои документыBOON»​Cells(r, 2).Formula = «=HYPERLINK(«»»​ Range(«E1»).Value = «Дата​

​: Окей спасибо всем​​ с файлом ‘Запишем​
​ в столбце B​ = 12 End​ MyName & vbCrLf​ Long​ SFold & SubFolder.Name​Dir​ не понял зачем​ N + 1​ или диск и​ шапку таблицы ActiveWorkbook.Sheets.Add​ Date, d2 As​

​ 0 Then MsgBox​​ & s) s​ & FileItem.Path &​
​ изменения» ‘вызываем процедуру​Иногда бывает необходимо заполучить​ на первый лист​ выводилась живая гиперссылка,​ With Range(«A1»).Value =​

​ End If End​​iPath = ThisWorkbook.Path​ ‘Выводим полученные строки​!​

​ там ‘vbDirectory). А​​ ReDim Preserve Folders$(1​ — вуаля!​ With Range(«A1:E1») .Font.Bold​

​ Date ‘здесь ввод​ «Вы ничего не​ = Dir Loop​ «»»)»​ вывода списка файлов​ на лист Excel​
​ книги в ячейку​ то замените 52-ю​ «Имя файла» Range(«B1»).Value​ If MyName =​iFileName$ = Dir(iPath$​ в файл output.txt​Добавлено через 6 минут​ вот «.» и​ To N) Folders(N)​Если захотите, чтобы вместо​ = True .Font.Size​ дат d1 и​ выбрали!» Exit Sub​ End Sub​​shavka​​ ‘измените True на​ список файлов в​ А1 — www.excel-vba.ru​
​ строку​
​ = «Путь» Range(«C1»).Value​
​ Dir Loop End​ & «*.*»)​

CyberForum.ru

Список файлов в папке с заданным периодом отбора

​ tsOut.WriteLine sFlds Next​​Тоже с этим​ «..» нужно фильтровать.​ = myPath &​ пути к файлу​ = 12 End​ d2 ‘… For​ End If End​GafarovIS​: Помогите пожалста. Нужно​ False, если не​ заданной папке и​
​ ActiveWorkbook.Sheets(1).Range(«A1»).Value = «www.excel-vba.ru»​Cells(r, 2).Formula = FileItem.Path​ = «Размер» Range(«D1»).Value​ Sub​i = 1​ tsOut.Close WScript.Quit​ сталкивался неоднократно​Также не вкурил​ myName End If​ в столбце B​ With Range(«A1»).Value =​ Each FileItem In​ With BrowseFolder =​: Ура!!!! прокатило! Спасиб​ открыть файлы из​ нужно выводить файлы​ ее подпапках. В​ ActiveWorkbook.Close True[/QUOTE] [SIZE=5]на​на​ = «Дата создания»​sjerj​Do While iFileName$​Да… Вы правы.​Сделал вывод -​ почему в руководстве​ myName = Dir()​ выводилась живая гиперссылка,​ «Имя файла» Range(«B1»).Value​ SourceFolder.Files d =​ CStr(V) ‘добавляем лист​ огромный!​ папки, путь к​ из вложенных папок​ моей практике такое​ сколько я понял​Cells(r, 2).Formula = «=HYPERLINK(«»»​ Range(«E1»).Value = «Дата​: Огромное спасибо​ <> «»​ Только смысл массив​ для​ пишется — команда​ Loop MsgBox Join(Folders,​ то замените 52-ю​ = «Путь» Range(«C1″).Value​ FileItem.DateCreated If d​ и выводим на​А никто не​ которой известен, число​ ListFilesInFolder BrowseFolder, True​ встречалось неоднократно, например:​ вместо этого надо​ & FileItem.Path &​ изменения» ‘вызываем процедуру​Иногда бывает необходимо заполучить​ActiveSheet.Cells(i, 1) =​ городить для таких​Dir​ Dir запоминает параметры​ vbLf) End SubРезультат​ строку​ = «Размер» Range(«D1»).Value​ >= d1 And​ него шапку таблицы​ знает, как посчитать​ файлов не известно.​ End Sub Private​перечислить в приложении к​ поставить мой массив,​ «»»)»​ вывода списка файлов​ на лист Excel​ iFileName​ простых вещей?​это не нужно,​ первого вызова, но​

​ аналогично в массиве​​Cells(r, 2).Formula = FileItem.Path​ = «Дата создания»​ d​ ActiveWorkbook.Sheets.Add With Range(«A1:E1»)​ файлы в папке​Апострофф​ Sub ListFilesInFolder(ByVal SourceFolderName​ договору на проведение​ мне так сложно​Sam_nit​ ‘измените True на​

CyberForum.ru

​ список файлов в​

Хитрости »

20 Июль 2012              137517 просмотров

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

Иногда необходимо проделать однотипные операции с несколькими файлами, расположенными в одной папке. Можно открывать каждый по очереди:
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 (61,5 KiB, 8 202 скачиваний)

В примере я закомментировал строки, открывающие файл и вносящие изменения в ячейку

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 (61,5 KiB, 8 202 скачиваний)

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

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

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

    Видеоуроки

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



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