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

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

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

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

Ошибка

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Помогите исправить макрос с помошью вашей функции т.к. мой макрос не работает в 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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