Список файлов в папке в таблицу 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 и что можно делать с её помощью

Получение списка файлов в указанной папке с помощью кода VBA Excel. Коллекция Files объекта Folder, возвращенного методом FileSystemObject.GetFolder.

Коллекция Files объекта Folder

Для получения списка файлов в указанной папке используется свойство Files объекта Folder. Объект Folder в VBA Excel возвращается методом GetFolder объекта FileSystemObject по полному имени папки в качестве аргумента.

Если в указанной папке нет файлов, применение свойства Folder.Files приведет к возникновению ошибки. Для корректного завершения программы используйте обработчик ошибок или условие, проверяющее наличие файлов в папке.

Получение списка файлов в папке

Пример 1

Код VBA Excel для получения списка файлов в указанной папке и записи полных имен файлов в массив (с поздней привязкой объектов к переменным):

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub Primer1() Dim fso, myPath, myFolder, myFile, myFiles(), i ‘Записываем в переменную myPath полное имя папки myPath = «C:DATAТекущая папка»     ‘Создаем новый экземпляр FileSystemObject     Set fso = CreateObject(«Scripting.FileSystemObject»)     ‘Присваиваем переменной myFolder ссылку на объект Folder     Set myFolder = fso.GetFolder(myPath)     ‘Проверяем, есть ли файлы в папке myFolder     If myFolder.Files.Count = 0 Then         MsgBox «В папке «» & myPath & «» файлов нет»         Exit Sub     End If ‘Задаем массиву размерность ReDim myFiles(1 To myFolder.Files.Count)     ‘Загружаем в массив полные имена файлов     For Each myFile In myFolder.Files         i = i + 1         myFiles(i) = myFile.Path     Next ‘Просматриваем первый элемент массива MsgBox myFiles(1) End Sub

Используемые переменные:

• fso – ссылка на экземпляр объекта FileSystemObject;
• myPath – полное имя папки;
• myFolder – ссылка на объект Folder (папка);
• myFile – ссылка на один объект File из коллекции myFolder.Files;
• myFiles() – массив для записи имен файлов;
• i – счетчик элементов массива.

Пример 2

Получение списка файлов в указанной папке и запись имен файлов в ячейки первого столбца рабочего листа Excel (с ранней привязкой объектов к переменным):

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Sub Primer2() Dim myPath, myFolder As Folder, myFile As File, i ‘Записываем в переменную myPath полное имя папки myPath = «C:DATAТекущая папка»     ‘Создаем новый экземпляр FileSystemObject     Dim fso As New FileSystemObject     ‘Присваиваем переменной myFolder ссылку на объект Folder     Set myFolder = fso.GetFolder(myPath)     ‘Проверяем, есть ли файлы в папке myFolder     If myFolder.Files.Count = 0 Then         MsgBox «В папке «» & myPath & «» файлов нет»         Exit Sub     End If     ‘Записываем имена файлов в первый столбец активного листа     For Each myFile In myFolder.Files         i = i + 1         Cells(i, 1) = myFile.Name     Next End Sub

Ранняя привязка позволяет использовать подсказки свойств и методов объектов при написании кода VBA Excel.

Как получить список папок до 3 уровней вложенности, смотрите в статье VBA Excel. Список папок.

---

Фразы для контекстного поиска: обход файлов.

---

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

• Для спонсоров 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

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

​Смотрите также​ версии не зависит?​ ActiveSheet.UsedRange).Rows.Delete Shift:=xlUp’ сократить​ в коде в​Novaya​ была добавка к​ GetAttr(myPath & myName)​

• ​ Пример 2003​ Sub Private Sub​ проще фильтровать их​ Next f »»»»»»»’Сортировка​ GetLast10Files() Dim i​Подсветил жёлтым 11ую​ FileItem.DateLastModified​
• ​Hugo​ ЗДЕСЬ всё-таки посмотрите.​
• ​ End If Columns(«A:E»).AutoFit​Иногда бывает необходимо заполучить​

​ Или это ограничение​ UsedRange​ 3-х местах «.JPEG»​: Помогите,пожалуйста.Стоит следующая задача:​ четвёртому посту.​ = vbDirectory And​Dutlf​ Init() Dim i​ сразу по ходу​ массива по дате»»»»»»»»»»»»»»»»»»»»»»»»​ As Long, j​

​ строку:​r = r + 1​: Диалог убить, вместо​​ Может пригодиться. У​​ Set FileItem =​ на лист Excel​ твоего любимого?​ActiveSheet.Cells(1, 1).End(xlDown).Offset(1).Select’сдвинуть экран​​ на «.JPG»​​ Есть папка с​На уровне подсознания​

​ myName <> «.»​: очень сильно благодарю!!!111​ As Long, startDate​ дела. Для 10​ For i =​ As Long, k​a(i, 2) =​X = SourceFolder.Path​ BrowseFolder прописать полный​ меня на работе​ Nothing Set SourceFolder​ список файлов в​Alex_ST​ к последней заполненной​И учтите, что​ картинками в формате​ я понимаю эту​ Then N =​Думала это что-то​ As Date ReDim​ нужных файлов и​ 1 To UBound(a,​ As Long, p​ fso.GetFile(p & f).Size​Next FileItem​ путь, переменной r​ многие им пользуются​ = Nothing Set​ заданной папке и​: Привет, Андрей!​ ячейке​ код написан не​ jpg, картинок там​ фишку, но сомневаюсь,​ N + 1​ из области фантастики,​ outData(1 To LastFileCount,​ тех же 10000​ 1) — 1​ As String, f​jack_21​Columns(«AQ:AR»).AutoFit​ задать значение 2.​Agn89​ FSO = Nothing​ ее подпапках. В​Вот в упор​End Sub​ для копирования, а​ порядка 100 тысяч,​ сумею ли внятно​ ReDim Preserve Folders$(1​ безумно помогли​ 1 To 3)​ в папке операций​ For j =​ As String, a(),​: Ну да. Именно​Set FileItem =​Ігор Гончаренко​: Добрый день!​ End Sub​ моей практике такое​ не помню. Разбирался​после удаления строк​ для переноса файлов.​ и есть Экселевский​ объяснить​ To N) Folders(N)​EducatedFool​ For i =​ потребуется 20 *​ i + 1​ fso, x Application.ScreenUpdating​ так и хотел…​ Nothing​: после выполнения Sub​необходима помощь в​

​Для запуска макроса нажмите​ встречалось неоднократно, например:​​ с этим в​​ UsedRange чистится не​​Guest​​ файл в котором​​Но попробую- Dir​​ = myPath &​:​ 1 To LastFileCount​ 10000, что быстрее.​

​ To UBound(a, 1)​ = False: [AP:AR].Clear​ Выгружать только последние​Set SourceFolder =​ M1 Shell «cmd​ корректировке макроса для​

​ сочетание клавиш​

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

​ июне и всё​ сразу (видно по​: Так как в​

planetaexcel.ru

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

​ перечислены 11 тысяч​​ ищет по сумме​ myName End If​Вот ещё вариант (с​ outData(i, 1) =​sokol92​
​ If a(i, 3)​
​ Set fso =​ 10.​ Nothing​ /c dir c:*.*​ составления списка файлов,​ALT+F8​ договору на проведение​ уже выветрилось из​ размеру «бегунка» прокрутки​ первом сообщении упоминалось​ названий картинок,которые лежать​ аттрибутов, поэтому 0​ myName = Dir()​
​ примером файла):​ startDate Next End​: Я полностью согласен​ < a(j, 3)​ CreateObject(«Scripting.FileSystemObject») p =​
​SAS888​Set FSO =​
​ >c:1.txt» end subразберите​ найденного на данном​, выберите наш макрос​ тренинга список файлов​ головы.​ строк), а только​ расширение файлов JPG,​ в папке со​ (vbNormal) на него​ Loop MsgBox Join(Folders,​rotten41​ Sub Private Function​ с сообщением #17.​ Then For k​

​ «X:BACKUPPPR2017» ‘Папка с​​: Проверяйте Sub GetLast10Files()​​ Nothing​
​ содержимое файла c:1.txt​
​ форме.​FileList​
​ из раздаточных материалов​На 2003-ем точно.​
​ по второму нажатию.​ то попробуйте заменить​
​ 100 тысячами картинок.Для​
​ не влияет, что​ vbLf) End SubРезультат​
​: Доброе утро, участники​
​ GetFiles(ByVal initPath As​ В​
​ = 1 To​ файлами (и разделителем)​
​ Dim i As​
​' форматирование текста​
​Agn89​
​1. необходимо вместо​

​и нажмите кнопку​ для особо щепетильных​ На 2007/2010, кажется,​

​Alex_ST​​ в коде в​ того,чтобы лучше понять​ бы ни указали​ аналогично в массиве​ форума.​ String, ByVal fileFilter​своих​ UBound(a, 2) x​​ ReDim a(1 To​​ Long, j As​Columns(«AP:AR»).Select​: Спасибо всем за​ выбора папки, указать​

​Выполнить (Run)​​ юристов в некоторых​ тоже. Но не​
​: Полирнул код и​ 3-х местах «.JPEG»​ приведу пример: допустим​ в параметре​ Folders.​

excelworld.ru

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

​Подскажите решение.​​ As String) As​
​программах я не​ = a(i, k):​ fso.GetFolder(p).Files.Count, 1 To​ Long, k As​With Selection.Font​
​ помощь. Ответ помог…​ путь к конкретной​. В диалоговом окне​ компаниях​
​ на 100% уверен.​ «продвинул» (расширил и​ на «.JPG»​ в Экселе есть​attributes​KoGG​У меня есть​ Shell32.FolderItems3 Dim pShell​ пользуюсь «пузырьком». Да,​ a(i, k) =​ 3) f =​ Long, p As​.Name = «Calibri»​jack_21​ папке.​ выберите любую папку​создать список файлов для​Но ведь проверить-то​ углУбил) интерфейс:​И учтите, что​ ячейка с таким​, поэтому и попадают​, а строку 11​ макрос, выводящий на​ As New Shell32.Shell​ если вас заранее​ a(j, k): a(j,​ Dir(p & «*.xls*»)​ String, f As​.Size = 9​: Добрый день!​2. при запуске​ или диск и​ ТЗ проекта​ просто: убери в​- добавлен лист​ код написан не​ значением 123456789, а​ в результат обычные​ лучше перенести в​ лист — список​ Dim pFolder As​ интересуют первые N​ k) = x​ Do While f​ String, a(), fso,​.Strikethrough = False​На сайте есть​ макроса необходимо обновлять​ — вуаля!​сравнить содержимое папок (оригинал​ коде ограничение на​ с избранными путями​ для копирования, а​ в папке с​ (vbNormal) файлы.​ позицию № 5,​ файлов, находящихся в​ Shell32.Folder3 Dim pItems​ записей результата, то​ Next: End If:​ <> «» i​ x Application.ScreenUpdating =​.Superscript = False​ такой топик:​ перечень файлов в​Если захотите, чтобы вместо​ и бэкап, например)​ количество гиперссылок и​ поиска и возможность​ для переноса файлов.{/post}{/quote}​ картинками лежит картинка​А потому и​ т.к. при задании​ выбранной папке.​ As Shell32.FolderItems3 Dim​ алгоритмы меняются (например,​ Next: Next »»»»»’Выгружаем​ = i +​ False: [AP:AR].Clear Set​.Subscript = False​Список файлов в папке​ папке а не​

​ пути к файлу​​Для реализации подобной задачи​ просканируй без ограничения​ выбора пути из​А как это​ в названием 123456789.jpg,​ необходима дополнительная фильтрация…​ несуществующего диска выбьет​Как заставить макрос​

​ curCount As Long​​ в СУБД Oracle​ на активный лист​ 1 a(i, 1)​ fso = CreateObject(«Scripting.FileSystemObject»)​

​.OutlineFont = False​​- выводит на​ добавлять к списку​ в столбце B​ отлично подойдет небольшой​

​ глубины что-нибудь монструозное,​​ их списка​ сделать?как изменить код?откровенно​ так вот нужно​ Вот(уж как сумел)​ ошибку на строке​

​ — выводить не​​ Set pFolder =​ для этого есть​

planetaexcel.ru

Список файлов в папке. Как ограничить количество записей?

​Для добавления макроса в​​ массивы большего размера.​ случайно не кликнуть​ VBE с кодом​Владимир​Тоже с этим​ Long D =​iPath = «D:»​ pItems Set pFolder​: [USER=55]Андрей VG, переместив​jack_21​ массива по дате»»»»»»»»»»»»»»»»»»»»»»»»​ Set x =​.VerticalAlignment = xlCenter​ собирает в папке​ V = .SelectedItems(1)​ одна проблема и​ вашу книгу нажмите​ В том числе​ на ссылку) гиперссылки​ макроса.​: Кто-то недавно делал​ сталкивался неоднократно​ Dir(path, vbDirectory) While​With CreateObject(«Shell.Application»)​ = Nothing Set​ модуль из вашего​: Упс!​ For i =​ fso.GetFile(p & f)​.WrapText = False​ на сервере. 1800​ If Err.Number <>​ как решить пока​ сочетание клавиш​ и в новых​ теперь не ставятся​3. Заменить слово​ так на форуме,​Сделал вывод -​
​ D <> «»​Dim iFolder As​ pShell = Nothing​ файла в свою​Я так понимаю,​ 1 To UBound(a,​ a(i, 1) =​.Orientation = 0​

​ файлов.)​​ 0 Then MsgBox​
​ не придумал, решил​ALT+F11​
​ версиях. При миллионе​ по умолчанию, а​
​ JPEG на слово​ выводил название файлов​

​ для​​ If GetAttr(path &​ Object, iFolderItem As​ End Function​ книгу макросов, он​

​ у меня в​​ 1) — 1​ fso.GetBaseName(p & f)​.AddIndent = False​- вставляет только​ «Вы ничего не​ получить консультацию.​, в открывшемся окне​ строк на листе,​ есть кнопка для​ JPG в 6-й​ в книгу Excel.​Dir​ «» & D)​ Object​Оригинал в посте​ перестал работать…​ системе (или в​ For j =​ ‘Имя файла без​.IndentLevel = 0​имя (без расширения) и​ выбрали!» Exit Sub​Суть:​ редактора Visual Basic​ это, мягко говоря,​ из установки/удаления​ (2 раза) и​ Думаю в этом​это не нужно,​ And vbDirectory Then​Set iFolder =​jack_21​»User-defined type not​ голове?) чего-то не​ i + 1​ расширения a(i, 2)​.ShrinkToFit = False​ даты​ End If End​Есть несколько папок​ вставьте новый модуль​ жалко выглядит.​- по даблклику​ 7-й (1 раз)​ направлении нужно работать…​а для​ ReDim Preserve a(U)​ .Namespace(iPath)​: Неожиданно возникла ошибка.​ defined» для строки​ хватает… Вставить через​ To UBound(a, 1)​ = x.Size ‘Размер​.ReadingOrder = xlContext​в указанный диапазон​ With BrowseFolder =​ с фотографиями. Фотографий​

​ через меню​​Alex_ST​ по имени файла​
​ строках снизу.​​Владимир​​Shell​ ​ a(U) = path​
​If Not iFolder​Compile error: Can’t find​Private Sub updateOut(ByVal thisFile​Insert — Module​ If a(i, 3)​ файла a(i, 3)​.MergeCells = False​ AP1:AR1/ колонки 42,​
​ CStr(V) ‘добавляем лист​ в папках около​Insert — Module​: или всё-таки 65535​
​ теперь можно открыть​
​4. Нажать Alt-F4​: Также можно сделать​
​и т.п. необходимо…​ & D U​
​ Is Nothing Then​ project or library​ As Shell32.FolderItem)​не получается. Всё​ < a(j, 3)​ = x.DateLastModified ‘Дата​End With​

​ 43, 44.​​ и выводим на​ 30 000 шт.​и скопируйте туда​ ?​ файл, по полному​ – закроется редактор​
​ гиперссылки на файлы,​Smith&Wesson​ = U +​For Each iFolderItem​и подсвечивает​Андрей VG​ красным светится.​ Then For k​ последней модификации f​End Sub​- Вставка в​ него шапку таблицы​ нужно в один​ текст этого макроса:​KuklP​ пути — открыть​ VBE.​ чтобы потом сопоставить​: А зачем так​ 1 End If​ In iFolder.Items​Time​: Подключите библиотеку Microsoft​jack_21​ = 1 To​ = Dir Loop​Помогите с кодом,​ ActiveWorksheet​ ActiveWorkbook.Sheets.Add With Range(«A1:E1″)​ столбец excel получить​Sub FileList() Dim​: А кто мешает​ папку​5. Проверить макрос,​ с кодами в​ все сложно, когда​ D = Dir​If iFolderItem.IsFolder =​v этой строке:​ Shell Controls And​: На 2007 сработало.​ UBound(a, 2) x​ »»»»»»»’Сортировка массива по​ плиз.​. / В Активный​ .Font.Bold = True​ названия всех этих​ V As String​ тебе открыть свой(наш)​- кнопки теперь​ нажав на кнопку.​ Excel.​ можно использовать объект​ Wend Get_DirS =​ True Then​Application.Wait CDate(CDbl(Time) +​ Automation​ Ошибки нету.​ = a(i, k):​ дате»»»»»»»»»»»»»»»»»»»»»»»» For i​Что надо подправить,​ Лист /. Путь​ .Font.Size = 12​ файлов, а во​

​ Dim BrowseFolder As​​ любимый и нажать​​ «интерактивные»​
​6. Сохранить книгу,​Guest​

​ Enumerator​​ a End Function​i = i + 1​
​ 1.15740740740741E-05)​jack_21​90 сек.​ a(i, k) =​ = 1 To​ что бы выводить​ не выводит. Я​

​ End With Range(«A1»).Value​​ второй столбец название​ String ‘открываем диалоговое​ ctrl+down?​- и что-то​ если заработало.​: Отобрали и что​Javascript var FSO,F,SFold,SubFolders,s;​ Sub Get_DirS_Example() Dim​Range(«A» & i)​Чего ему вдруг​: Подключил. Заработало.​Максим Зеленский​ a(j, k): a(j,​
​ UBound(a, 1) -​ только​ его и так​ = «Имя файла»​ папки из которой​ окно выбора папки​RAN​ ещё (не помню)​Guest​ дальше? Действия какие​ FSO=WScript.CreateObject(«Scripting.FileSystemObject»); //Путь к​ a a =​ = iFolderItem.Name​ стало не хватать?​jack_21​: это не VBA​ k) = x​ 1 For j​последние 10 файлов?​ знаю.​ Range(«B1»).Value = «Путь»​ эта фотография. Если​ With Application.FileDialog(msoFileDialogFolderPicker) .Title​: ГЫ! У меня​Прошу прощения. Обнаружил​: Оно!более того,мне нужно​ надо производить с​ каталогу SFold=»C:\Program Files»;​ Get_DirS(«C:Documents and Settings»)​End If​ Чего надо подключить?​: Андрей VG, Протестировал​но на 2007​ Next: End If:​ = i +​Последние по времени​А вложенных папок​ Range(«C1»).Value = «Размер»​ это имеет значение,​ = «Выберите папку​ даже там всего​ ошибку​ было кроме картинок​ файлами?​ s=»Каталог «+SFold+»n»; s+=»Подкаталоги:n»;​ End SubПричем работают​Next​jack_21​ на работе. Практически​ работать не будет.​ Next: Next »»»»»’Выгружаем​ 1 To UBound(a,​ редактирования.​ нету.​ Range(«D1»).Value = «Дата​ то названия кириллицей.​ или диск» .Show​ половина!​

​Файл отсюда удаляю.​​ ещё и txt-файлы​​Действий никаких после​ //Создаем объект Folder​ они зачастую быстрее​Else​: Нашёл. В VBA​​ мгновенное срабатывание в​​на 2010 и​ на активный лист​

​ 1) If a(i,​​Modified​Скрытый текстSub FileListNumbersH()​​ создания» Range(«E1»).Value =​

​Возможно ли как​​ On Error Resume​
​Alex_ST​ Исправленный файл -​
​ таким же образом​ этого производить не​ для каталога C:Program​ стронних библиотек.​
​MsgBox «Указанная папка​ — References одна​ случае сканирования сетевой​

​ 2013 нужна надстройка​​ последние по дате​ 3) < a(j,​. Идеально, если это​
​’ Список файлов​ «Дата изменения» ‘вызываем​
​ то осуществить такое​ Next Err.Clear V​: Серёга, а ты​ в следующем посте.​ отобрать,так вот поменяв​ нужно,мне нужно отобрать​

​ Files F=FSO.GetFolder(SFold); //Создаем​​If GetAttr(myPath &​
​ изволит отсутствовать», ,​ из библиотек имела​
​ папки…​
​ Power Query для​
​ 10 файлов»»»»»»»»»»»» i​ 3) Then For​ количество можно будет​ в папке​ процедуру вывода списка​

​ и если возможно​​ = .SelectedItems(1) If​ про что без​Alex_ST​ в макросе jpg​ только те картинки,имена​ коллекцию подкаталогов каталога​ myName) = vbDirectory​ «»​ пометку MISSING. Снял​На разных компах​ Excel.​

​ = IIf(UBound(a, 1)​​ k = 1​ менять редактированием кода.​Dim V As​ файлов ‘измените True​ помогите кто чем​ Err.Number <> 0​ пояснения написал​: Ещё раз прошу​
​ на txt это​ которых есть в​ C:Program Files SubFolders=​ And myName <>​End If​ галку — вроде​ время слегка разнится​В 2016 она​ < 10, UBound(a,​ To UBound(a, 2)​Не могу найти​ String​ на False, если​ может.​ Then MsgBox «Вы​Я вообще-то говорил​ прощения за допущенную​ случилось,моё счастье наполнено​ экселевском файле, для​ new Enumerator(F.SubFolders); //Цикл​ «.» And myName​End With​

​ заработало.​​ — от 0,5сек​ уже встроена в​ 1), 10) [AP1].Resize(i,​​ x = a(i,​​ мне понятных примеров​Dim BrowseFolder As​ не нужно выводить​За ранее всем​ ничего не выбрали!»​ про количество гиперссылок​ в предыдущем посте​ счастьем!​ того чтобы потом​ по всем подкаталогам​ <> «..» ThenИ​End Sub​

​Эта библиотека осталась​​ до 4 сек.​ Excel​ 3).Value = a​

​ k): a(i, k)​​ в сети.​ String​ файлы из вложенных​ спасибо.​ Exit Sub End​
​ на листе. Так​ ошибку в процедуре.​
​Alex_ST​ только эти,отобранные картинки​

​ for (; !SubFolders.atEnd();​​ так даже приходилось​Если True заменить​ от надстройки, которая​

​jack_21​​jack_21​

​ End Sub​​ = a(j, k):​p.s. Отсекать лишнюю​BrowseFolder =​ папок ListFilesInFolder BrowseFolder,​PS как получать​
​ If End With​ их ТОЧНО 65530​Кроме того, наткнулся​: Выводится список файлов,​

​ загрузить на сайт.​​ SubFolders.moveNext()) { s+=SubFolders.item()+»n»;​ писать​ на False, будут​ была установлена на​: Не могу разобраться,​: Максим Зеленский,в 2016​jack_21​
​ a(j, k) =​ инфу в названии​»X:BACKUPPPR2017″​ True End Sub​ мне не принципиально,​ BrowseFolder = CStr(V)​Я это проверял​ на недокументированное ограничение​ найденных в заданной​Guest​ //Добавляем строку с​Smith&Wesson​ файлы.​ домашнем компе.​ какую часть кода​ вставил Ваш код​: На 2007 работает.​ x Next: End​ файла буду с​’BrowseFolder = CStr(V)​ Private Sub ListFilesInFolder(ByVal​ если получиться сделать​ ‘добавляем лист и​ в пошаговом режиме​ Excel: гиперссылок на​ папке.​: Так и как​ именем подкаталога }​:​rotten41​А проблема возникла​ надо повесить на​ в запрос PQ.​Время = 25 сек.​ If: Next: Next​ помощью записанного макроса:​’добавляем лист и​ SourceFolderName As String,​ по одной папке​ выводим на него​ (естественно, не нажимая​ листе может быть​Можно задавать глубину​ отбирать-то?я не совсем​ //Выводим полученные строки​Апострофф​: Wasilich, работает.​ на рабочем компе,​ кнопку, чтобы это​Создал запрос. Вывел​Вечером проверю на​ »»»»»’Выгружаем на активный​ «Ctr+H» + формула​ выводим на него​ ByVal IncludeSubfolders As​ и получать только​ шапку таблицы ActiveWorkbook.Sheets.Add​ 65000 раз F8,​ не более 65530​ «погружения» в подпапки​ поняла:-)какие мои действия?Что​ на экран WScript.Echo(s);P.S.​, да, я был​Огромное спасибо за​ где эта надстройка​ заработало с кнопки​ данные на Лист.​ 2016.​ лист последние по​ «=правсимв()»​ шапку таблицы​ Boolean) Dim FSO​ один столбец с​ With Range(«A1:E1») .Font.Bold​ а тормознув программу​ штук.​ и маску имён​ сделать с файлом,который​ код не мой,​ не прав. vbDirectory=32,​ совет.​ не была установлена.​ в UserForm. Подскажите,​Поверхностно попробовал -​
​Максим Зеленский​

​ дате 10 файлов»»»»»»»»»»»»​​SAS888​
​’ActiveWorkbook.Sheets.Add​ As Object Dim​
​ названиями фотографий, то​​ = True .Font.Size​​ Stop’ом на 65520​
​Просканировал у себя​ файлов​
​ Вы прикрепили?​ но всегда пользуюсь​ если папка в​

​vova_net​​Правильно ли я​ пожалуйста…​ работает вроде. Классная​: Power Query не​ i = IIf(UBound(a,​: Попробуйте так: Sub​
​With​ SourceFolder As Object​ меня это тоже​ = 12 End​
​- лень было​ Programm Files и​В ячейки столбцов​Guest​
​ им, как шаблоном​ корне и =​
​: Подскажите как получить​ понимаю :​Option Explicit Private​ штука! Вот только​ подойдет?​ 1) < 10,​
​ GetLast10Files() Dim i​ActiveSheet.Range(«AP1:AR1»)​
​ Dim SubFolder As​ устроит, папки я​
​ With Range(«A1»).Value =​ делать Exit For​

​ при попытке расставить​​ для каждого из​: Наверно я просто​Smith&Wesson​ 16, если это​

planetaexcel.ru

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

​ гиперссылки вылетел в​​ найденных файлов выводятся:​ не совсем поняла​

​, в посте #2​​ подкаталог.​ заданной директории (при​ на компе С​

​ Long = 10​​ меня установлен Office​ Folder.Contents(«путь к папке»),​ [AP1].Resize(i, 3).Value =​ As String, f​.Font.Bold = True​
​ As Object Dim​

​ тогда проставлю. Всё​​ = «Путь» Range(«C1»).Value​А строк на​ отладку​- имя файла​ вопрос.После того как​ то же самое,​

​Эту строку ‘If​​ этом имена файлов​
​ НАДСТРОЙКОЙ, в файл/-ы​ ‘ количество выгружаемых​ 2007.​

​ Sorted = Table.Sort(Source,{{«Date​​ a End Sub​

​ As String, a(),​.Font.Size = 10​

planetaexcel.ru

Вывод названий папок в целевом каталоге. (Макросы/Sub)

​ r As Long​​ же быстрее чем​ = «Размер» Range(«D1»).Value​
​ листе нашего любимого​
​Ошибку исправил. Ограничение​ — гиперссылка на​ файлы с картинками​ только на другом​ GetAttr(path & «»​
​ в список попадать​ внедрилась какая-то инфа​ записей Private outData()​Андрей VG​ modified», Order.Descending}}), KeptFirstRows​jack_21​ fso Application.ScreenUpdating =​
​End With​

​ Set FSO =​​ 30 000 фото​
​ = "Дата создания"​
​ 2003-го, действительно 65536.​
​ учёл.​
​ файл​ будут отобраны их​ языке, и результат​
​ & D) And​ не должны)?​
​ не работающая БЕЗ​ As Variant Public​
​: Доброе время суток​ = Table.FirstN(Sorted,10), RemovedOtherColumns​
​: Огромное спасибо. "Сработала​ False: [AP:AR].Clear Set​
​Range("AP1").Value = "Name"​
​ CreateObject("Scripting.FileSystemObject") Set SourceFolder​ руками вбивать.​
​ Range("E1").Value = "Дата​
​А в ящике​
​adaebella​
​- полный или​ нужно​ в массиве.​
​ vbDirectory Then' я,​
​KoGG​
​ установленной этой надстройки?​​ Sub FindLastPPR() Dim​Сколько у вас​ = Table.SelectColumns(KeptFirstRows,{«Name», «Date​

​ дудочка» (с)​​ fso = CreateObject(«Scripting.FileSystemObject»)​
​Range(«AQ1»).Value = «Created»​ = FSO.getfolder(SourceFolderName) r​

excelworld.ru

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

​Nic70y​​ изменения» ‘вызываем процедуру​ пива 24 бутылки,​: здраствуйте Alex ST​ сокращённый (от заданной​поместить в другую​Smith&Wesson​

​ конечно, подсмотрел на​​: Dim Folders() As​Подскажите плиз, где​ neededFiles As Shell32.FolderItems3​ там файлов?​ modified»}) in RemovedOtherColumns​Вот только неожиданно​ p = «X:BACKUPPPR2017″​Range(«AR1»).Value = «Modiefed»​ = Range(«A65536»).End(xlUp).Row +​:​ вывода списка файлов​ а в сутках​ . мне очень​ папки) путь к​ папку,чтобы отобранные ИСКОМЫЕ​, вы ошиблись разделом​ MSDN, но нифига​ String Sub Subfolders_in(Folder$)​ корень зла?​ Dim nextFile As​Вариант.​sokol92​долго​

​ ‘Папка с файлами​​’вызываем процедуру вывода​
​ 1 ‘находим первую​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Private Sub Workbook_Open()​ ‘измените True на​ 24 часа. Совпадение?​ нужна ваша помощь​ файлу​ 11000 картинок лежали​ форума. Здесь обсуждается​ не понял зачем​ Dim N% Dim​HOME = w8.1×64​ Shell32.FolderItem Set neededFiles​Успехов.​: Использование функции dir​он собирает информацию.​ (и разделителем) ReDim​ списка файлов​ пустую строку ‘выводим​Columns(«A:A»).ClearContents​ False, если не​KuklP​ в екселе .​- дата и​ в отдельной папке.так​ язык программирования VBA.Только​ там ‘vbDirectory). А​ fs, f, f1,​ + mso2010​ = GetFiles(«F:!!!_BACKUP-PPPAVADZIMES2017», «*.*»)​P. S. sokol92,​ в сообщениях #5​32секунды!!!​
​ a(1 To fso.GetFolder(p).Files.Count,​​’измените True на​ данные по файлу​Dim iPath As​ нужно выводить файлы​: Леш, это делается​ пожалоста ответь мне​ время создания файла​

​ пойдёт?​​ заметил, что ветка​ вот «.» и​ fc Set fs​WORK = w8.1×64​ ‘ C:WindowsSystem32 Init​ если нужны только​ и #7 излишне,​Задумка была, что​ 1 To 3)​ False, если не​ For Each FileItem​ String​ из вложенных папок​ без stop. add​ или здесь или​- размер файла​АБВ​ по VBA В​ «..» нужно фильтровать.​ = CreateObject(«Scripting.FileSystemObject») Set​ + mso2007​ For Each nextFile​ 10 файлов, то​ так как коллекция​ бы не открывать​ f = Dir(p​ нужно выводить файлы​
​ In SourceFolder.Files Cells(r,​Dim iFileName As​ ListFilesInFolder BrowseFolder, True​ watch — i=65530​ прямо в скайп​- дата и​: Как вариант.​

​ таком случае, функция​​Также не вкурил​​ f = fs.GetFolder(Folder)​​sokol92​ In neededFiles updateOut​ зачем формировать данные​ files уже содержит​ папку и не​ & «*.xls*») Do​
​ из вложенных папок​ 1).Formula = FileItem.Name​ String​ End Sub Private​ — ставим радиоточку​ : ruslan4963 .​ время модификации файла​Просмотреть можно так.​ будет следующая:​ почему в руководстве​
​ Set fc =​: Читаем про «раннее​ nextFile Next ActiveSheet.Range(«AR2»).Resize(LastFileCount,​ по всем файлам?​ информацию о всех​ проверять номер последнего​ While f <>​ListFilesInFolder BrowseFolder, True​ Cells(r, 2).Formula =​
​Dim i As​ Sub ListFilesInFolder(ByVal SourceFolderName​ на break if​ зарание спасибо и​Прицеплен «Удобный автофильтр»,​Guest​’Объявляем переменные Dim​ пишется — команда​ f.SubFolders N =​ и позднее связывание»​ 3).Value = outData​

​sokol92​​ файлах папки p.​ файла. А так​ «» i =​End Sub​ FileItem.Path Cells(r, 3).Formula​
​ Long​ As String, ByVal​ true. Потом этот​ буду ждать своево​ позволяющий легко фильтровать​: Вот с указанием​ FSO, SFold, SubFolders,​ Dir запоминает параметры​ 0 On Local​ (у Вас в​ ‘ выгрузка в​: Здравствуйте, Андрей! Я​ Вероятно, использование этой​
​ получается что быстрее​ i + 1​Private Sub ListFilesInFolder(ByVal​ = FileItem.Size Cells(r,​iPath = ThisWorkbook.Path​
​ IncludeSubfolders As Boolean)​ watch можно редактировать​ ответа. с уважениям​ полученные данные.​ директории с файлами.​ sFlds, tsOut ‘Создаем​ первого вызова, но​​ Error Resume Next​​ примере раннее).​ /ActiveSheet.Range(«AR2»)/ End Sub​ не вступал в​
​ же функции и​ руками найти и​ a(i, 1) =​
​ SourceFolderName As String,​
​ 4).Formula = FileItem.DateCreated​iFileName$ = Dir(iPath$​ Dim FSO As​ прямо в окне​ Русан​​Alex_ST​​ Указываете папку с​
​ объект FileSystemObject Set​
​ в моем коде​ For Each f1​
​Dutlf​ Private Sub updateOut(ByVal​​ соревнование, просто убрал​​ приводит к ошибке,​
​ проверить.​​ fso.GetBaseName(p & f)​​ ByVal IncludeSubfolders As​

​ Cells(r, 5).Formula =​​ & «*.*»)​ Object Dim SourceFolder​ watches:-)​KuklP​
​: К стати, кто​ файлами для перемещения.​ FSO = WScript.CreateObject(«Scripting.FileSystemObject»)​ она все равно​ In fc N​: Имеется папка, в​ thisFile As Shell32.FolderItem)​ в сообщении #7​ указанной в сообщении​Где проблема? Проверял​ ‘Имя файла без​ Boolean)​ FileItem.DateLastModified r =​i = 1​ As Object Dim​Alex_ST​: adaebella, для таких​ подскажет, где я​ В данной папке​ ‘Создаем файл, куда​

​ выводит в т.ч.​​ = N +​ ней лежит порядка​ Dim pos As​ ненужную там функцию​ #6. Вариант без​​ на Office 2007.​​ расширения a(i, 2)​Dim FSO As​ r + 1​Do While iFileName$​ SubFolder As Object​: Серёга, хорош флудить.​ сообщений есть кнопка​
​ нахомутал (просто, наверное,​ создается(если еще не​ будем записывать имена​ имена файлов.​ 1 ReDim Preserve​ 100 файлов-excel.​ Long, i As​ dir, которая к​ dir:​ Дома на 2016​ = fso.GetFile(p &​ Object​ X = SourceFolder.Path​ <> «»​ Dim FileItem As​KuklP​ «Приват».​ глаз замылился)?​ создана) папка «MovingFiles»,​ подкаталогов Set tsOut​И еще вопрос:​ Folders(1 To N)​
​Названия у них​ Long, fileDate As​ тому же некорректно​Sub GetLast10Files() Dim​
​ посмотрю.​ f).Size ‘Размер файла​Dim SourceFolder As​ Next FileItem ‘вызываем​
​ActiveSheet.Cells(i, 1) =​ Object Dim r​: А где флуд?​Alex_ST​Заметил при тестировании​

CyberForum.ru

Как отобрать из папки картинки в формате jpg, имена которых перечислены в Экселевской таблице?

​ в которую и​​ = FSO.CreateTextFile(«output.txt», True,​ написано, что нужно​ As String Folders(N)​ разные и не​ Date fileDate =​ работает с именами​ i As Long,​——————————————————————————————————-​ a(i, 3) =​ Object​ процедуру повторно для​ iFileName​ As Long Set​ Все по теме.​: Ждите ответа, ждите​ два мелких косяка:​ отбираются файлы.​ False) ‘Путь к​ ставить двойные кавычки​ = Folder &​ имеют никакой последовательности.​ thisFile.ModifyDate pos =​ файлов, не отображамых​ j As Long,​А вот на​ fso.GetFile(p & f).DateLastModified​Dim SubFolder As​ каждой вложенной папки​i = i + 1​

​ FSO = CreateObject(«Scripting.FileSystemObject»)​​Alex_ST​ ответа, ждите ответа,​1. Значение чек-бокса​Объясните, пожалуйста, поподробнее,я​ корневому каталогу SFold​ Chr(34), если в​

​ «» & f1.Name​​Можно ли с​ -1 For i​ в кодовой таблице​ k As Long,​ 2016 не сработало.​

​ ‘Дата последней модификации​​ Object​ If IncludeSubfolders Then​iFileName$ = Dir​ Set SourceFolder =​
​: Подправил файл (там,​ ждите ответа, ждите​ SheetFind.CheckBox_ShortPath при открытии​ не поняла что​ = «C:Program Files»​ имени папки есть​ & «» Next​ помощью excel получить​ = 1 To​

​ по умолчанию (Windows-1251).​​ p As String,​Error 53/ File​ f = Dir​Dim FileItem As​ For Each SubFolder​

​Loop​​ FSO.getfolder(SourceFolderName) r =​ оказывается, поломалась расстановка​ ответа…​ файла сохраняется таким,​ делать,вот у меня​ Set Folder =​
​ пробелы. Но у​ f1 End SubСписок​ список названий файлов,​ LastFileCount If outData(i,​Андрей VG​

​ f, a(), fso,​​ not found.​
​ Loop [AP1].Resize(UBound(a, 1),​

​ Object​​ In SourceFolder.SubFolders ListFilesInFolder​End Sub​ Range(«A65536»).End(xlUp).Row + 1​ гиперссылок)​А вообще, правильно​ каким оно было​ есть эксэлевский файл​ FSO.GetFolder(SFold) ‘Цикл по​ меня все работает​
​ с полными путями​ которые лежат в​ 1) < fileDate​: Коллега, я не​ files Application.ScreenUpdating =​Подсветило жёлтым, начиная​ UBound(a, 2)).Value =​Dim r As​

​ SubFolder.Path, True Next​​всего не читал​

​ ‘находим первую пустую​​Алексей​ написал Сергей: личные​ при сохранении перед​ который вы прислали​ всем подкаталогам for​ и без них.​ в массиве Folders()​ папке?​ Then pos =​

​ рассматриваю обсуждение как​​ False: [AP:AR].Clear Set​ с двоеточия и​ a ‘Выгружаем на​ Long​ SubFolder End If​ — только название​ строку ‘выводим данные​
​: Подскажите , а​ вопросы — в​ закрытием. А вот​ и есть папка​

​ Each SubFolder In​​ И наоборот ничего​Апострофф​nilem​ i Exit For​ соревнование. Скорее как​ fso = CreateObject(«Scripting.FileSystemObject»)​ до конца строки:​
​ активный лист [AP:AR].Sort​Set FSO =​ Columns(«A:E»).AutoFit Set FileItem​ темы…​
​ по файлу For​ как сделать так​ личной почте. А​ переменная ShortPath, которую​ с сотней тыщ​

​ Folder.SubFolders sFlds =​​ не выдает/работает неверно,​: Вариант:​
​: Файлы в папке.​
​ End If Next​ способ коллективно найти​ p = «X:BACKUPPPR2017″​ i = i​
​ [AR1], xlDescending, Header:=xlNo​ CreateObject(«Scripting.FileSystemObject»)​ = Nothing Set​gling​ Each FileItem In​ что бы еще​
​ если вопрос по​ я пытаюсь по​ картинок,что делать дальше?​
​ SFold & SubFolder.Name​ если их указать.​
​Sub Dirs() Dim​ Пример (2007)​

​ If pos >​​ оптимальное решение при​ ‘Папка с файлами​ +1 : Set​ ‘Сортируем по дате​Set SourceFolder =​ SourceFolder = Nothing​: Есть вариант, макросы​ SourceFolder.Files Cells(r, 1).Formula​ можно было особым​

planetaexcel.ru

Поиск файлов в папке и её подпапках (Для тех, кто точно помнит, что файл был, но вот где?)

​ теме, то спрашивайте​​ нему выставить в​Guest​ ‘Выводим полученные строки​
​Казанский​ myName$, myPath$, N%,​nilem​ -1 Then For​
​ обсуждении темы всеми​ (и разделителем) Set​ x = fso.GetFile(p​
​ Range(«AP11:AR» & Rows.Count).ClearContents​ FSO.getfolder(SourceFolderName)​ Set FSO =​
​ от разных производителей,​ = FileItem.Name Cells(r,​ образом помечать файлы​ здесь.​
​ процедурах обработки событий​: Занавес…​
​ в файл output.txt​
​: А что бы​ Folders$() On Local​
​: Файлы в папке​ i = LastFileCount​ заинтересованными лицами. Плюс,​

​ files = fso.GetFolder(p).files​​ & f)​ ‘Оставляем первые 10​r = Range(«A65536»).End(xlUp).Row​ Nothing End Sub​
​ объединенных в одном​ 2).Formula = FileItem.Path​
​ и удалять их​Но сразу предупреждаю:​ Workbook_Open, Worksheet_Activate, Worksheet_Activate​Guest​ tsOut.WriteLine sFlds Next​ в список попали​ Error Resume Next​ и подпапках. Пример​ — 1 To​ чему-нибудь научиться.​ ReDim a(1 To​SAS888​ файлов End SubФорматирование​ + 1 ‘находим​StoTisteg​ файле. Может и​
​ Cells(r, 3).Formula =​​ ?​
​ дистанционным обучением VBA​ ставиться не хочет.​
​: Спасибо за подробное​ tsOut.Close WScript.Quit​
​ всякие с причудами​ myPath = InputBox("Введите​
​ (2007)​ pos Step -1​Просто в вашем​
​ files.Count, 1 To​: 1. Большое время​ полученной таблицы добавьте​
​ первую пустую строку​​: Не понял этой​ вам пригодится. Для​ FileItem.Size Cells(r, 4).Formula​Alex_ST​ я не занимаюсь​ Поэтому перед первым​

​ описание, разобралась, но​​Да… Вы правы.​ директории, можно написать​ директорию», , «c:temp»)​
​Dutlf​ outData(i + 1,​ коде проблема с​ 3) For Each​ сбора информации, скорее​
​ самостоятельно.​’выводим данные по​ фразы, ведь окно​ включения в список,​ = FileItem.DateCreated Cells(r,​
​: Дорабатывать надо… И​ и за деньги​ поиском приходится чекнуть​ после обработки в​ Только смысл массив​ так -​ If Right(myPath, 1)​: ничего не понятно,​ 1) = outData(i,​ методом сортировки пузырьком.​
​ f In files​ всего, связано не​Если принципиально, то​ файлу​ диалога — способ​ содержимого под папок,​
​ 5).Formula = FileItem.DateLastModified​ самое главное -​
​ писать программы не​ бокс туда-обратно чтобы​
​ папке MovingFiles пусто.​ городить для таких​
​D = Dir(path,​ <> «» Then​ файлы не откываются,​

​ 1) outData(i +​​ Если у ТС​ If LCase(f.Name) Like​ с макросом, а​ можно отсортировать строки​
​For Each FileItem​ указать путь к​ необходимо указать на​ r = r​ придумать как именно​ собираюсь, т.к. Excel-2003​
​ результат ему соответствовал.​ Я проверяла соответствие​ простых вещей?​ vbDirectory Or vbHidden​ myPath = myPath​
​ можно как-нибудь тлько​ 1, 2) =​

​ 10000 файлов, то​​ «*.xls*» Then i​ с медленным доступом​ внутри массива и​ In SourceFolder.Files ‘​ папке. Видимо, он​любой документ​ + 1 X​ удобно​ — моё хобби,​2. В процедуре​ названий в эксэле​На VB данная​

​ Or vbSystem) While​​ & «» If​ экселевский файл выложить​ outData(i, 2) ‘outData(i​

​ это будет долго​​ = i +​ к сетевому диску.​ выгружать на лист​ вставка в столбец​
​ Вас не устраивает,​вне этих папок​ = SourceFolder.Path Next​Но мне это​ а не источник​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub ОчисткаСписка()​ и в папке​
​ стандартная функция, по-моему,​ D <> «»​ Dir(Left(myPath, Len(myPath) -​ с нужным примеро?​ + 1, 3)​ 10000 * 10000​ 1 a(i, 1)​2. Почему метод​ не весь массив,​
​ 42, 43, 44​ а какой устраивает,​ (рядом с этими​ FileItem ‘вызываем процедуру​

​ не нужно, а​​ дохода.​On Error Resume​ с картинками, тут​ ещё проще и​

​ If GetAttr(path &​​ 1), 16) =​
​Спасибо​ = outData(i, 3)​ в среднем операций.​ = f.Name ‘Имя​ fso.GetFile выдает ошибку​ а только последние​
​Cells(r, 42).Formula =​ Вы не пишете.​ папками). Думаю разберетесь.​ повторно для каждой​
​ времени свободного сейчас​А по Скайпу​ Next​ всё в порядке.​ понятнее. ИМХО…​ «» & D)​ «» Then MsgBox​

​nilem​​ Next outData(pos, 1)​ Чтобы не писать​ файла без расширения​ в Excel 2016​ (по дате) 10​ Left(FileItem.Name, InStrRev(FileItem.Name, «.»)​StoTisteg​ Здесь про список​ вложенной папки If​ нет…​ я не общаюсь​If ActiveSheet.FilterMode Then​ZVI​Может не прав,​

​ And vbDirectory And​​ «Папка не существует!»:​: Нажимаем зеленую кнопку.​

​ = fileDate ‘​​ Quick Sort я​ a(i, 2) =​ не знаю (не​ файлов.​

​ — 1) ‘​​: А так вообще​Alex_ST​ IncludeSubfolders Then For​

​Так что извините,​​ ни с кем​ ActiveSheet.ShowAllData’ сбросить фильтры​: Так как в​
​ но всегда считал,​ D <> «.»​ Exit Sub myName​ Заполняется список экселевских​
​ fileDate outData(pos, 2)​ и предложил, раз​ f.Size ‘Размер файла​ могу протестировать). Но​jack_21​имя файла БЕЗ расширения​​ имеет смысл смотреть​: Хоть уже и​ Each SubFolder In​
​ но я сейчас​ кроме своих друзей.​Intersect(Rows(«6:» & Rows.Count),​
​ первом сообщении упоминалось​ чем проще и​ And D <>​ = Dir(myPath, vbDirectory)​

​ файлов, находящихся в​​ = thisFile.Name ‘outData(pos,​ нужно только ограниченное​ a(i, 3) =​ можно этот метод​: Нет. Не работает.​Cells(r, 43).Formula =​ в сторону этого​ не нужно, наверное…​ SourceFolder.SubFolders ListFilesInFolder SubFolder.Path,​

​ с этим ковыряться​​RAN​

​ ActiveSheet.UsedRange).ClearContents’ удалить содержимое​​ расширение файлов JPG,​ меньше код -​

​ «..» Then ‘далее​​ Do While myName​ текущей папке (в​ 3) = thisFile.Size​

​ число файлов по​​ f.DateLastModified ‘Дата последней​ вообще не использовать.​error 53 -​ FileItem.DateCreated​ решения:​Но готовый файл​ True Next SubFolder​

​ просто не могу.​​: Леш, это от​Intersect(Rows(«7:» & Rows.Count),​ то попробуйте заменить​ тем лучше.​
​ по текстуУпсс: Это​ <> «» If​ которой находится файл-обработчик).​ End If End​
​ дате, то тогда​ модификации End If​ Например так: Sub​ File not found​

excelworld.ru

​Cells(r, 44).Formula =​