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 КБ85912 минуты 5 секунд назад
FilenamesCollectionEx.xls56 КБ80871 минута 6 секунд назад

Комментарии

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

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

Здравствуйте, Оксана
Это уже сложнее, - значение указанного свойства можно извлечь только из тех файлов, где оно есть
(из произвольного файла, например, текстового, или 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

как отключить поиск скрытых файлов таких как Thumbs.db если я просто делаю список файлов?

Возникла точно такая же ошибка - "Sub or function not defined". Скачала Ваш макрос - тоже ошибку выдает. Excel- 2010. В чем же может быть дело?

Прошу прощение за беспокойство, уже решил свою проблему.

Здравствуйте, Сергей
Ошибка из-за неправильного использования функции
Покажите свой кусок кода с поиском файла - подскажу, как написать правильно.

Здравствуйте, спасибо за функцию, мне очень пригодилась.

Я функцию использую для поиска конкретного файла. В случае если искомого названия нет, выскакивает ошибка Invalid procedure call or argument. Возможно ли ее как-то локализовать?

слова "не можете" не сильно профессионально звучат из ваших уст )))
все настройки у мня по вашим рекомендациям
и если не открывает, то не НЕ открываю я а прога не открывает
винда 7-ая, новый ноут
никаких сбоев в офисе за последнее время не обнаружено
говорю то что есть.. остальное лирика
с удовольствием выслушаю поправки, в каких случая такое возможно
давайте по сути

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

не знаю как у других, но у меня в папке до 2500 фото имена которых мне нужно вытащить (абсолютно все .jpg), а используя FilenamesCollectionEx.xls находит от силы 20-30 не сильно рабочая штука )))

Я "по мотивам" этой процедуры уважаемого Игоря уже давно сделал для себя файл-утилиту для поиска по папкам и подпапкам со всяческими полезными примочками.
В интранете с сетевыми папками вроде бы работает нормально.
Вот здесь файл: http://yadi.sk/d/cpv-QumhFvCG3
А здесь - топик с обсуждением: http://www.excelworld.ru/forum/3-1894-21255-16-1340871322

Здравствуйте.

Работаю в Excel 2007. Нужно, чтобы из конкретной папки (из сети) выводило список всех, находящихся в ней фалов (имена). Файлы в формате .xlsx. Изменил всё, что было необходимо, но выводит только чистый лист с заголовками "№", "Имя файла", "Полный путь".
В чем может быть ошибка?
Спасибо.

P.S. я не особо силён в написании макросов.

И в Word работать будет, - только вывод результатов в документ надо будет делать иначе.
А сама функция, никак не привязана к Excel

А в Ворде Function FilenamesCollection() работать будет? И вообше какому злу понадобилось убирать FILESEARCH из 2007

Нашёл отличную бесплатную программу TagScanner
Там во вкладке List Maker в настройках экспорта нужно выбрать шаблон csv-excel который можно изменить
вставив например следующий код:

# Tagscanner export script

$file_name TrackList.csv
$file_notes Excel-friendly comma-separated text
$file_encoding utf-8
$file_writebom 1

$document_open
"№";"путь к файлу";"имя файла";"длительность";"название композиции";"год";"обьём"

$select %_index%,0
"%_counter%";"%filepath%";"%filenameext%";"%_totallength%";"%title%";"%year%";"%_filesize%"
$endselect

"Общее количество файлов: %_totalfiles%"
"Общий обьём файлов: %_totalsize%"
"Общая длительность файлов: %_totallength%"

$document_close

Пишу это потому что потратил много времени на поиск нужного решения (сканирования и экспорт в csv mp3 файлов).
И может быть кому то это поможет быстрее решить подобный вопрос.

И ещё скажите пожалуйста каким должен быть код чтобы в полном пути к файлу не отображалось само название файла а только названия папок в которых файл находится ?
Это наверно где то в этом месте надо что то изменить.

выводим результаты на лист
For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам
sh.Range("a" & sh.Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
Array(i, coll(i), Dir(coll(i))) ' выводим на лист очередную строку
DoEvents ' временно передаём управление ОС

Вывести длительность звукового файла, вам поможет эта функция:
http://excelvba.ru/code/MCI

С первым вопросом разобрался:
ПутьКПапке = "G:\AUDIO\"
- надо в кавычках указать путь.

Здравствуйте. Скажите пожалуйста как можно в следующем коде макроса
указать путь к другой папке например G:\AUDIO\A08_Robota_s_Radio\Radio

Dim coll As Collection, ПутьКПапке As String
' получаем путь к папке РАБОЧИЙ СТОЛ
ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' считываем в колекцию coll нужные имена файлов
Set coll = FilenamesCollection(ПутьКПапке, ".mp3", 3)

И дополнительный вопрос, если возможно, то как в следующем столбце вывести длительность звучания mp3 файла в таком виде например:
0:05:19 ?

Никаких библиотек подключать не надо.
Скорее всего, при копировании кода, вы просто потеряли его часть.
Откройте прикреплённые к статье файлы, - там ведь всё работает?

Здравствуйте

Спасибо большое за вашу огромную работу и кучу полезной информации.

Перечитала комметарии - похоже ни у кого такой проблемы не возникало.

У меня стоит Excel 2010, при выполнении кода возникает ошибка "Compile error: Sub of Function not defined" с выделением FilenamesCollection. Почитала в Интернете поняла что нужно зайти в Tools - References и выбрать недостоющую библиотеку, но как понять какую именно? Ни одна из библиотек не missing...

Заранее большое спасибо.

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

Здравствуйте, Олег.
Это называется не «форматировать», а «сортировать»
Можно сортировку выполнить как перед выводом данных на лист, так и уже в итоговой таблице Excel
Ничего невозможного нет.
PS: Код на все эти варианты писать не буду, - ибо этого кода много получится. Могу сделать под заказ.

Понимаю, что тема старая, но есть вопрос) Можно ли форматировать построение списка файлов по имени, по дате, по типу...... и как это можно сделать кодом VBA Заранее благодарю.

Практически вопрос снят, так как проблема была решена... Код полностью рабочий и в этом нет сомнений...
Прична неправильной работы скрипта была в том, что имена файлов содержали нестандартные символы присутсвующие в чешской кодировке... после переименовании этих файлов скрипт отработал полностью... (таких дисков из нескольких сотен оказалось только 2)
Однако непонятно, почему в столбце "Полный путь" теже имена отбражались нормально, а столбец "Имена файлов" оставался пустым...

Прошу прощения...не те заголовки скопировал в предыдущем посте))

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

и

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

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

Добрый день всем) Такой вопросик, если мне нужно макрос чтобы он по файловой системе искал файлы имя которых написаны в ячейке? Никак не получается совместить

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

и

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

так, чтобы он брал имена файлов из определенного диапазона ехсеl...
Вообще нужно чтобы макрос просто создавал гиперссылку на файл (найденный поиском) имя которого в ячейке.

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

Дак ведь я и не сомневаюсь... код рабочий, под виндой 2003 сп3 и офисом 2003 все работало... четыре сотни дисков в каталог занес... сменили комп на ноут... винда семерка, офис 10... и вот проблемы с записью данных с сд... ничего не понимаю...

Петрович, этот макрос изначально предназначался для чтения списка файлов из папки на HDD.
И с этой задачей он справляется на отлично.

Почему он с DVD и CD не работает у вас — я не знаю.
У меня никаких проблем с этим нет: (засунул первый попавшися DVD в комп, и проверил)

чтение списка файлов с CD и DVD

Другое дело, что при работе с CD и DVD макрос работает намного медленнее, — но это вполне естественно, ибо скорость доступа к данным на DVD намного ниже, по сравнению с жестким диском.

Так что ищите проблему на своём компе. В коде точно проблем нет
(этим макросом ежедневно пользуются сотни людей - и ни одного нарекания за несколько лет)

Устранил и блокировал техническую поддержку и системных администраторов... сложнее было со службой безопасности, но и они здались... однако все остается по прежнему, с одним лишь изменением... При считывании данных с жестких дисков - все работает нормально... а вот с сидирома или дивидирома - как я и описывал... В чем может быть проблема???

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

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

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

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

Чтобы имя файла выводилось без расширения,
вместо строки

ИмяФайла = Dir(ПутьКФайлу)

напишите

ИмяФайла = Left(Dir(ПутьКФайлу), InStrRev(Dir(ПутьКФайлу), ".") - 1)

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

Буду рад помощи!!!

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

Option Explicit Const inputFolder = "c:\temp\", outFolder = "c:\out\" 'должна существовать Const logName = "log.txt" 'по условиям задачи, будет находиться в outFolder Dim folderCount As Long, stbar As Boolean, startTime As Date Dim frags() As String, fragsCount As Long Sub ledk() Dim x As Range, i As Long 'формируем массив со строками для сравнения Set x = Range("A1").End(xlDown) If x = "" Then x = Range("A1") 'в списке одно значение fragsCount = x.Row ReDim frags(fragsCount) For i = 1 To fragsCount frags(i) = "*" & Cells(i, 1) & "*" Next Open outFolder & logName For Append As #1 startTime = Time folderCount = 0 stbar = Application.DisplayStatusBar Application.DisplayStatusBar = True Print #1, "******* начало перемещения файлов " & Date & " " & Time ' запускает процесс с исходной папки processFolder inputFolder Print #1, "******* конец перемещения файлов " & Date & " " & Time & _ ", папок " & folderCount & ", время " & Format(Time - startTime, "hh:mm:ss") Close #1 Application.DisplayStatusBar = stbar Application.StatusBar = False Debug.Print folderCount & Format(Time - startTime, ", hh:mm:ss") End Sub Private Sub processFolder(fName As String) Dim fso As Object, file As Object, fileName As String, i As Long folderCount = folderCount + 1 Application.StatusBar = folderCount & " " & fName Set fso = CreateObject("scripting.filesystemobject") Set fso = fso.getfolder(fName) ' Для каждого файла в папке ... For Each file In fso.Files fileName = file.Name For i = 1 To fragsCount ' Если значение ячейки содержится в имени файла, то в файл-лог выводится путь к файлу, ' файл перемещается в папку назначения If fileName Like frags(i) Then ' If InStr(1, fileName, x, vbTextCompare) > 0 Then 'оказалось медленнее Print #1, file.Path file.Move outFolder Exit For End If Next Next ' Для каждой подпапки в папке просто вызывается эта же подпрограмма! For Each file In fso.subfolders processFolder file.Path Next End Sub

Этот код работает в 2007 офисе, но он ищет похожие имена, а мне нужно имена в которых содержится часть строки целиком. Допустим 123 а файл назван 123П, такой должен найтись, ноне 132. Кто- нибудь может подсказать, что мне нужно изменить?

Здравствуйте, Кирилл.

Макросу без разницы, сколько строк выводить, - зависит только от количества строк на листе

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

Попробуйте преобразовать файл в формат Excel 2007 - и, когда увидите, что на листе стало больше миллиона строк, - тогда и запускайте макрос.

Инструкция по преобразованию файла Excel в новый формат:
(для Excel 2010, в Excel 2007 делается аналогично)

преобразование файла в формат Excel 2007

А как сделать, чтоб данный макрос больше 65 тысяч строк выводил, сохранение
в xlsx не помогло?

Игорь, а какие 45 (от 0 до 44) параметров файла возвращаются в элементах массива функцией GetFileInfo ?
Хочу положить её к себе в "копилку", но нужно иметь полное описание(а вдруг когда-нибудь понадобится, когда придётся объект "Shell.Application" использовать?)

Чтобы извлечь такую информацию, надо глубже залазить в файл - считывать EXIF данные при помощи VBA.
Кстати, далеко не все фотоаппараты записывают указанные данные.

Смотрите, так надо было?

Надо дополнительно использовать функцию получения свойств файла:

Function GetFileInfo(ByVal PathName As String, ByVal FileName As String)
    On Error Resume Next
    If Dir(PathName & IIf(Right(PathName, 1) <> "\", "\", "") & FileName) = "" Then Exit Function
    ReDim a(0 To 44)
    With CreateObject("Shell.Application").Namespace((PathName))
        For j = 0 To UBound(a)
            a(j) = .GetDetailsOf(.ParseName((FileName)), j)
        Next
    End With
    GetFileInfo = a
End Function

Ну и вносим изменения в код вывода списка файлов:

        ' считываем все свойства файла
        x = GetFileInfo(Replace(ПутьКФайлу, ИмяФайла, ""), ИмяФайла)
 
        ' выводим на лист очередную строку
        Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 7).Value = _
        Array(НомерФайла, ИмяФайла, ПутьКФайлу, x(25), x(24), x(26), РазмерФайла)
Если сами не разберетесь - могу выслать файл с примером (за небольшое вознаграждение)

Подскажите, как вместо "Даты создания" получить "Дату снимка", т.е. самую первую дату записи файла.
FileDateTime и DateCreated не подходят - это скорее последние измения файла и т.п.

Игорь, я всего-навсего для проверки своего макроса, созданного "по мотивам" Вашего, но с использованием словаря и вывода данных на лист из его массива, просканировал у себя на компе C:\Program Files чтобы найти пустые папки и нулевые файлы.
Согласитесь, что такая задача вполне реальна.
Ну а защитить код от вылета, ограничив вывод максимальным числом строк приложения, а расстановку гиперссылок - числом 65530 совсем не трудно. Что я в своей процедуре и сделал. Уже отдал просившим ребятам. Со вчерашнего дня тестируют. Пока больше замечаний нет.

Вообще-то, ограничение это где-то было описано - по крайней мере, я что-то нашел про это через Google.
(хотя я тоже про него не знал, пока в своей программе не столкнулся с исчезновением гиперссылок после 65000 строк)

Макросы, выложенные в этой статье, как и любые другие макросы на моём сайте, изначально не предназначены для работы с огромными объёмами данных, так что изменять код я не буду.
Какой смысл превращать простенький бесплатный макрос в огромного сложного монстра, приспособленного под всевозможные обстоятельства?
Причин, при которых макрос не будет работать, можно найти множество: например, попытка записать список из 100тыс. файлов на лист Excel 2003 (65536 строк), или попытка создать список из имён 2 миллионов файлов (они не влезут даже на лист Excel 2010), зависание Excel или Explorer при попытке загрузки огромного списка файлов (сотни тысяч или миллионы файлов, если поиск начинать с корня системного диска), отключение внешнего носителя во время операции чтения списка файлов, и т.д. и т.п.
И что, я должен в макросе из нескольких строк всё это учесть?

Обычно формируемый в Excel список файлов не превышает 100-10000 позиций, так что абсолютное большинство пользователей ни с какими проблемами не столкнётся.
А кому надо будет что-то навороченное - тот заплатит мне денежку, и получит оптимизированный сложный макрос под конкретную задачу.

Я тут наткнулся на недокументированное ограничение Excel: гиперссылок на листе может быть не более 65530 штук.
Надо добавить ограничение в код чтобы не вылетало в ошибку.

Здравствуйте, Марина.
Конечно можно. Загружаете файл XML с сайта, и анализируете его содержимое.
Весь необходимый код можно найти у меня на сайте.

Добрый день!
А можно как-то сделать так, чтобы список файлов извлекался из xml-каталога, размещенного на веб-странице?

fil - это переменная. Как именно она называется - не столь важно, лишь бы имя не совпадало с зарезервированными служебными именами.
Можно заменить на f или fl или file_, или el...
Перевод
For Each fil In curfold.Files
звучит так:
для каждого fil из файлов curfold
fil и curfold - это имена переменных, могут быть такими, какие Вы им дадите.

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

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

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

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