mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Получение списка файлов в папке и подпапках средствами VBA

Макрос VBA загрузки списка файлов из папки

Функция VBA для получения списка файлов из папки,
с учётом выбранной глубины поиска в подпапках

 

Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки) 

Пример в файле FilenamesCollectionEx.xls более функционален - он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.

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

ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)

Внимание: если требуется, чтобы поиск не зависел от регистра символов в маске файла
(к примеру, обнаруживались не только файлы .txt, но и .TXT и .Txt),
поставьте первой строкой в модуле директиву Option Compare Text

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 999) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути найденных файлов
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function
 
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        ' раскомментируйте эту строку для вывода пути к просматриваемой
        ' в текущий момент папке в строку состояния Excel
        ' Application.StatusBar = "Поиск в папке: " & FolderPath

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже
            For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function


' Пример использования функции в макросе:

Sub ОбработкаФайловИзПапки()
    On Error Resume Next
    Dim folder$, coll As Collection
 
    folder$ = ThisWorkbook.Path & "\Платежи\"
    If Dir(folder$, vbDirectory) = "" Then
        MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Нет папки ПЛАТЕЖИ"
        Exit Sub        ' выход, если папка не найдена
    End If
 
    Set coll = FilenamesCollection(folder$, "*.xls")        ' получаем список файлов XLS из папки
    If coll.Count = 0 Then
        MsgBox "В папке «" & Split(folder$, "\")(UBound(Split(folder$, "\")) - 1) & "» нет ни одного подходящего файла!", _
               vbCritical, "Файлы для обработки не найдены"
        Exit Sub        ' выход, если нет файлов
    End If
 
    ' перебираем все найденные файлы
    For Each file In coll
        Debug.Print file        ' выводим имя файла в окно Immediate
    Next
End Sub


Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:

Sub ПримерИспользованияФункции_FilenamesCollection()
    ' Ищем на рабочем столе все файлы TXT, и выводим на лист список их имён.
    ' Просматриваются папки с глубиной вложения не более трёх.

    Dim coll As Collection, ПутьКПапке As String
    ' получаем путь к папке РАБОЧИЙ СТОЛ
    ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, ".txt", 3)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ' создаём новую книгу
    Dim sh As Worksheet: Set sh = Workbooks.Add.Worksheets(1)
    ' формируем заголовки таблицы
    With sh.Range("a1").Resize(, 3)
        .Value = Array("№", "Имя файла", "Полный путь")
        .Font.Bold = True: .Interior.ColorIndex = 17
    End With
 
    ' выводим результаты на лист
    For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам
        sh.Range("a" & sh.Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
        Array(i, Dir(coll(i)), coll(i))    ' выводим на лист очередную строку
        DoEvents    ' временно передаём управление ОС
    Next
    sh.Range("a:c").EntireColumn.AutoFit    ' автоподбор ширины столбцов
    [a2].Activate: ActiveWindow.FreezePanes = True ' закрепляем первую строку листа
End Sub

Ещё один пример использования:

Sub ЗагрузкаСпискаФайлов()
    ' Ищем файлы в заданной папке по заданной маске,
    ' и выводим на лист список их параметров.
    ' Просматриваются папки с заданной глубиной вложения.

    Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%
 
    ПутьКПапке$ = [c1]    ' берём из ячейки c1
    МаскаПоиска$ = [c2]    ' берём из ячейки c2
    ГлубинаПоиска% = Val([c3])    ' берём из ячейки c3
    If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999    ' без ограничения по глубине

    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' выводим результаты (список файлов, и их характеристик) на лист
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к файлам

        НомерФайла = i
        ПутьКФайлу = coll(i)
        ИмяФайла = Dir(ПутьКФайлу)
        ДатаСоздания = FileDateTime(ПутьКФайлу)
        РазмерФайла = FileLen(ПутьКФайлу)
 
        ' выводим на лист очередную строку
        Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
        Array(НомерФайла, ИмяФайла, ПутьКФайлу, ДатаСоздания, РазмерФайла)
 
        ' если нужна гиперссылка на файл во втором столбце
        ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
                                   "Открыть файл" & vbNewLine & ИмяФайла
 
        DoEvents    ' временно передаём управление ОС
    Next
End Sub

PS: Найти подходящие имена файлов в коллекции можно при помощи следующей функции:

Function CollectionAutofilter(ByRef coll As Collection, ByVal filter$) As Collection
    ' Функция перебирает все элементы коллекции coll,
    ' оставляя лишь те, которые соответствуют маске filter$ (например, filter$="*некий текст*")
    ' Возвращает коллекцию, содержащую только подходящие элементы
    ' Если элементы не найдены - возвращается пустая коллекция (содержащая 0 элементов)
    On Error Resume Next: Set CollectionAutofilter = New Collection
    For Each Item In coll
        If Item Like filter$ Then CollectionAutofilter.Add Item
    Next
End Function

ВложениеРазмерЗагрузкиПоследняя загрузка
FilenamesCollection.xls35 КБ73971 час 23 минуты назад
FilenamesCollectionEx.xls56 КБ68371 час 29 минут назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Да, можем сделать такой макрос под заказ.
Минимальная стоимость заказа 1500 руб.

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

или например на основе Вашего FilenamesCollectionEx.xls нашел все файлы на диске/папке нужные -нажимаешь на файл и ты нужен выбрать ячейку куда вписать имя файла
заранее спасибо

У меня почему-то размер файла в байтах выводится абсолютно иной, иногда даже с отрицательным значением.
Пример:
1.вес файла 3 840 327 Кб или 3,66 Гб, а таблица выдает "-362 472 675"
2.вес файла 5 082 087 Кб или 4,84 Гб, таблица выдает "909 089 137"

Василий, да, можно добавить.
Пример код можете здесь посмотреть:
http://excelvba.ru/code/MCI

Добрый день! Подскажите, возможно ли добавить столбцы "продолжительность" и "ширина кадра", которые имеются в данных файлов?

Здравствуйте, Елизавета.
Причин может быть несколько, навскидку:
- проблемный файл, или файл, к которому у вас нет доступа (ошибка 53 - файл не найден)
- слишком длинное имя папки (много уровней вложенности) и/или файла
- сбой в файловой системе
- ошибка в макросе (что-то в коде не учтено)

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

Игорь, огромное вам спасибо за эту работу!
Несколько лет использую ваш файл для классификации фильмов, но пару недель назад почему-то он перестал работать. Никакой критичности в этом нет, т.к. главное исправила благодаря обсуждениям тут, но мне непонятно и жутко интересно, почему так происходит. Может, это связано с активацией офиса(примерно в то же время было)? Офис 10й.
У меня 2 вкладки в этом файле, обновляю список на 2й, и затем новые позиции копирую в первую (накапливаю). При обновлении списка, после 60-70 позиций, макрос останавливается и сообщает об ошибке Run-time error 53 со сслыкой на строку ДатаСоздания = FileDateTime(ПутьКФайлу). Дело не файле, т.к. его удаление не помогло. Я добавила в скрипт "On Error Resume Next", список обновляется до конца, но перестают запускаться фильмы по гиперссылке в 1й вкладке "не удается открыть указанный файл" (во 2й работают), хотя файл и макросы одни и те же... Знаете, в чем может быть причина?

Спасибо!!!!!

Олег, посмотрите такое решение: RenameFiles

Добрый день! Помогите в написании макроса.
Задача: подобрать фото в отдельную папку (по имени файла) из бооольшой кучи фотографий (лежат в одной папке). Список необходимых фото (по имени файла) в таблице Excel списком. + необходимо отметить в этой таблице, какие фото подобрались.

заранее спасибо.
Олег.

Огромное спасибо автору!

Добавьте первой строкой в макросе:

On Error Resume Next

Ошибка

Run-time error '52':
Bad file name or number

Ошибка в строке
ДатаСоздания = FileDateTime(ПутьКФайлу)

Не сталкивался с проблемой
Моя функция не может выдавать ошибку, - т.к. в ней отключен вывод сообщений об ошибках
Ни разу с подобным не сталкивался, - функция работает в составе моих программ на тысячах компов.
Какая строка МОЕГО кода выдает ошибку?

Здравствуйте, все работает спасибо) Только выдает ошибку когда название файла содержит нестанадартные знаки, иероглифы там и тому подобное. Не подскажете как исправить?)

Макрос обрабатывает папки с любым количеством файлов, - и десятки тысяч файлов не проблема (не говоря уж о 200 файлах)
Если не работает, - вы что-то не так в коде прописали.

Макрос не работает с большим объемом файлов.. папку с 200 файлами он не обрабатывает. Как поправить?

Здравствуйте, Андрей.
С сетевыми путями (UNC) - тоже все работает.
Вот так написал - и получил список файлов

folder$ = "\\MYCOMP\Users\Public\фото"

Убедитесь, что у вас достаточно прав для просмотра списка файлов в указанной папке.

Спасибо. Очень полезная функция. Но, к сожалению, не ищет в сетевых папках без буквы дисковода :-(
Т.е., если папка поиска указана как "\\NetComp1\dir1\dir2" - искать не будет. А не всегда есть возможность присвоить буковку...
Нельзя ли что-нибудь придумать, чтобы работало с сетевыми путями?
С уважением, Андрей.

Спасибо огромное, пользуюсь несколько лет, всё здорово работает,
НО:
обнаружилось неприятное свойство - не работает поиск в сетевых папках, если не назначена буква дисковода. Т.е. "\\Network\dir1\dir2" в пути начала поиска не прокатывает :-(. Нельзя ли что-нибудь "подкрутить", чтобы работало?... А нельзя ли из VBA скрипта запускать поиск в стандартном окне Windows (то, что открывается по нажатию "Win+F"). Думается, во многих случаях это был бы идеальный вариант.
С уважением, Андрей.

Олег, надо внимательно все проверять. Была ли создана предварительно папка с нужным именем, правильно ли указан путь к ней (не написано ли "C:\" с русской буквой С, например), в том ли месте в макросе разместили указанные строки и т.д.

Если VBA даешь команду, он ее исполняет, значит не в том месте команда была дана или ошибку где-то допустили.

Антон, спасибо большое за ответ. Я проверил, но при одновременном выводе списка файлов в листе, копирования в указанную папку, тех файлов, которые отобразились в этом листе, не происходит.

Олег, внимательно смотрите приведенные примеры. Там уже всё есть.

' если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
"Открыть файл" & vbNewLine & ИмяФайла

Для копирования файла добавьте в функцию GetAllFileNamesUsingFSO следующие строки

sNewFileName = "С:\папка для копий\Копия " & fil.Name 'имя файла
FileCopy fil, sNewFileName 'копируем файл

При этом папка для копий файлов уже должна быть создана

Возможно ли в этом открывшимся листе Excel, каждому имени файла из списка присвоить гиперссылку на найденный файл?

Подскажите пожалуйста, а как сделать чтобы найденные файлы еще копировались в другую указанную папку?

Отличный сайт, полезные функции. Спасибо автору!!!!

Артем, замените строку

' получаем путь к папке РАБОЧИЙ СТОЛ
ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")

на
ПутьКПапке = "c:\"

Подскажите, пожалуйста, как сделать, чтобы поиск происходил по диску С:, а не по рабочему столу?

Большое спасибо. Всё очень хорошо работает. Донесено до народа творчески и аккуратно. Главное идеи и подходы, а детали мы уже сами..... Удачи!!!

Здравствуйте, Allanian.
Для вашей задачи макрос нужно дорабатывать, - можем сделать под заказ.
Оформляйте заказ на сайте, прикрепляйте примеры файлов, и подробно описывайте, что и как должно работать.

здравствуйте, подскажите
Есть например, 10 файлов в названии которых написано имя компьютера, и в самом файле на 2 строчке есть это же имя компьютера.
Как можно собрать названия файлов в эксель в 1 столбик или собрать имена компьютеров из 2 строчки в столбик в экселе. Помогите плис... на работе завал вручную переписывать

При обращении к файлам содержащим немецкие символы типа "умлаут" выдает пустую строку "" в поле 2 - "гиперссылка".

Здравствуйте, Владимир.
Да, дописать макрос возможно.

Доброго времени суток ВСЕМ! Подскажите возможно ли дописать макрос, что бы при задании периода, в "Список файлов в папке" попали только файлы "по дате создания". Спасибо.

Спасибо большое завтра попробую на работе проверить.

Роман, ваш макрос будет выглядеть так:

Sub rodent()
    Dim coll As Collection, folder$
 
    folder$ = "d:\eq\in"
    Set coll = FilenamesCollection(folder$, "*.*", 1)        ' получаем список файлов

    If coll.Count > 0 Then
        For a = 1 To coll.Count
            in_file = coll(a)
            out_file = folder$ & "\PRT" & Format(a, "00#") & ".doc"
            i = FileLen(in_file)
            ReDim in_Array(i) As Byte: ReDim out_Array(i) As Byte
 
            Open in_file For Binary As #1: Get #1, 1, in_Array(): Close #1
 
            Dim io As Long: io = 1
            For ii = 1 To i
                Select Case in_Array(ii)
                    Case &H1B: ii = ii + 1
                        Select Case in_Array(ii)
                            Case &HE, &HF, &H23, &H30 To &H37, &H3C To &H3E, &H40, &H45 To &H48, &H4D, &H4F, &H50, &H54
                            Case &H19, &H20, &H21, &H25, &H2D, &H2F, &H33, &H41, &H43, &H49, &H4A, &H4E, _
                                 &H51 To &H53, &H55, &H57, &H61, &H6C, &H6B, &H70, &H77, &H78, &H74: ii = ii + 1
                            Case &H24, &H5C, &H4B, &H4C, &H59, &H5A, &H3F: ii = ii + 2
                            Case &H5E: ii = ii + 3
                        End Select
                    Case &HE, &HF, &H11 To &H15, &H18, &H7F        ', &HC
                        'Case &HC: out_Array(io) = 10: io = io + 1
                        'добавить распознование 2х подряд идущих 0D
                    Case Else: out_Array(io) = in_Array(ii): io = io + 1
                End Select
            Next ii
            ReDim Preserve out_Array(io)
            Open out_file For Binary As #1: Put #1, 1, out_Array(): Close #1
        Next a
    End If
 
End Sub

Помогите исправить макрос с помошью вашей функции т.к. мой макрос не работает в 2010 офисе из за функции Application.FileSearch. пробовал переделать не получилось почемуто не находит ни одного файла в папке. Суть такая есть в папке D:\eq\in несколько файлов типа PRTDSK.001 PRTDSK.002 итд которые надо обработать. Помогите переделать кусок кода под вашу функцию поиска. Заранее благодарен.
Sub rodent()
With Application.FileSearch
.LookIn = "d:\eq\in"
.FileName = "*.*"
If .Execute() > 0 Then
For a = 1 To .FoundFiles.Count
in_file = .FoundFiles.Item(a) ': out_file = Left(in_file, Len(in_file) - 8) & "1\sss.txt"
'in_file = Left(.Filename, 7) & Format(a, "00#")
out_file = .LookIn & "\PRT" & Format(a, "00#") & ".doc"
i = FileLen(in_file)
ReDim in_Array(i) As Byte: ReDim out_Array(i) As Byte

Open in_file For Binary As #1: Get #1, 1, in_Array(): Close #1

Dim io As Long: io = 1
For ii = 1 To i
Select Case in_Array(ii)
Case &H1B: ii = ii + 1
Select Case in_Array(ii)
Case &HE, &HF, &H23, &H30 To &H37, &H3C To &H3E, &H40, &H45 To &H48, &H4D, &H4F, &H50, &H54
Case &H19, &H20, &H21, &H25, &H2D, &H2F, &H33, &H41, &H43, &H49, &H4A, &H4E, _
&H51 To &H53, &H55, &H57, &H61, &H6C, &H6B, &H70, &H77, &H78, &H74: ii = ii + 1
Case &H24, &H5C, &H4B, &H4C, &H59, &H5A, &H3F: ii = ii + 2
Case &H5E: ii = ii + 3
End Select
Case &HE, &HF, &H11 To &H15, &H18, &H7F ', &HC
'Case &HC: out_Array(io) = 10: io = io + 1
'добавить распознование 2х подряд идущих 0D
Case Else: out_Array(io) = in_Array(ii): io = io + 1
End Select
Next ii
ReDim Preserve out_Array(io)
Open out_file For Binary As #1: Put #1, 1, out_Array(): Close #1
Next a
End If
End With
End Sub

попробуйте так:

For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
     If not fil.Name Like "*.xyz"  Then FileNamesColl.Add fil.Path ' все файлы, кроме файлов с расширением .xyz
Next

если несколько расширений надо исключить, - то так:

For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
     If (not fil.Name Like "*.xyz") and (not fil.Name Like "*.vfr") and (not fil.Name Like "*.prn")  Then FileNamesColl.Add fil.Path 
Next

Здравствуйте!
Вопрос у меня такой, как сделать так, чтобы не показывались файлы с определенным разрешением
Выше вы приводили пример как сделать, чтобы не грузились системные файлы, но у меня не хватает ума переделать строчку, чтобы искались файлы не по полному имени, а по расширению.
Заранее спасибо автору!!!

ИмяФайла = Dir(ПутьКФайлу)
при обращении к файлам типа *.db, *.ini и т.п. выдает пустую строку ""
В данном случае лучше использовать строчку ниже, которая определяет имена любых файлов
ИмяФайла = FSO.GetFileName(ПутьКФайлу)

Никита, я вот сейчас в яндексе написал запрос «VBA дата создания файла»
и, о чудо, по первой же ссылке был нужный код...

Остается только правильно прикрутить этот код к имеющемуся макросу

PS: Если сами не разберетесь, - всегда можно оформить заказ на сайте

Игорь, здравствуйте! Очень полезный макрос, все отлично работает! Но никак не могу разобраться, мне требуется вытащить еще дату создания файла на диске, потому что у вас дата изменения,последнего, на самом-то деле:) Хотел бы вставить строчку вот сюда:
НомерФайла = i
ПутьКФайлу = coll(i)
ИмяФайла = Dir(ПутьКФайлу)
ДатаИзменения = FileDateTime(ПутьКФайлу)'у вас это как ДатаСоздания' было
ДатаСоздания....
РазмерФайла = FileLen(ПутьКФайлу)

Пробовал несколько методов, поискал в интернете, дебагер ошибку выдает постоянно. Количество столбцов в массиве увеличивал конечно же.

Заранее спасибо за помощь!

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

Владислав, да мне несложно помочь, - но я не вижу файла с макросом
Исправлять ошибку - 10 секунд, а вот выяснять у вас все подробности - намного больше времени займёт.

Если хотите бесплатной помощи - обратитесь на форумы по Excel
Ну или мне в скайп позвоните (сегодня я добрый)), от вас надо будет: http://ExcelVBA.ru/help

Игорь, здравствуйте. Пытался у Вас просить помощи - а Вы сразу за деньги... Но "надежда умирает последней" - применил корректировку указанных строк и при запуске макроса выскочила ошибка "Runtime error '5'" - через "Debug" выкидывает окно макроса с выделением строки откорректированной строки. Поможете?
Заранее благодарю.

Здравствуйте, Оксана
Это уже сложнее, - значение указанного свойства можно извлечь только из тех файлов, где оно есть
(из произвольного файла, например, текстового, или Excel, такие данные не получить)

В файлах Word в свойствах есть такое
Если из открытого файла считывать, - то так:

x = ThisDocument.BuiltinDocumentProperties("Number of characters with spaces")

Если файл Word закрыт - то так:
With CreateObject("shell.application").namespace("Путь к папке с файлом" & "\")
x = .getdetailsof(.Items.Item("имя файла с расширением"), 30)
End With

где 30 - номер свойства (возможно, число понадобится другое)

Доброго дня!!
Вы написали ОЧЕНЬ полезный макрос и от меня Вам БОЛЬШОЕ СПАСИБО!!!!
Я не сильна в написании макросов и поэтому у меня к Вам просьба - подскажите как можно в дополнительной колонке написать данные "Знаков и пробелов" из свойств каждого файла

ошибка - "Sub or function not defined" - возникает потому, что вы скопировали в свой файл только пример использования функции, а саму функцию - нет.

Посмотрите пример в прикреплённом файле - там есть все необходимые макросы и функции

Чтобы отключить поиск скрытых файлов таких как Thumbs.db - надо подправить код:
вместо

For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
      If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
Next

написать что-то вроде
For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
      If (fil.Name Like "*" & Mask)  and (fil.Name <>"Thumbs.db") and (fil.Name <>"desktop.ini") Then FileNamesColl.Add fil.Path
Next

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _       _  _     __  __             __        __  _____ 
| | | || | | \/ | __ __ \ \ / / |___ /
| | | || |_ | |\/| | \ \ /\ / / \ \ /\ / / |_ \
| |___ |__ _| | | | | \ V V / \ V V / ___) |
|_____| |_| |_| |_| \_/\_/ \_/\_/ |____/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.