It will be pretty time consuming searching an entire drive. I create getFileList to recursively search all folders and subfolders returning the file paths in an array. You could speed up the process by having the function exit when it finds the correct directory.
I recommend saving the path to the registry using SaveSetting and later retriving it using GetAllSettings
The HowTo_GetFileList macro shows you how you can filter the array of file paths.
Sub HowTo_GetFileList()
Const MATCHVALUE As String = "Demo"
Dim f, FileList, FilteredList
FileList = getFileList("C:UsersOwnerDownloads")
FilteredList = Filter(FileList, MATCHVALUE)
For Each f In FilteredList
'Do Something
Next
End Sub
Function getFileList(localRoot As String, Optional fld, Optional ftpArray)
Dim fso, f, baseFolder, subFolder, ftpFile, i
Set fso = CreateObject("Scripting.Filesystemobject")
If IsMissing(fld) Then
Set baseFolder = fso.GetFolder(localRoot)
Else
Set baseFolder = fld
End If
For Each f In baseFolder.Files
If IsMissing(ftpArray) Then
ReDim ftpArray(0)
Else
i = UBound(ftpArray) + 1
ReDim Preserve ftpArray(i)
End If
ftpArray(i) = f.Path
Next
For Each subFolder In baseFolder.SubFolders
getFileList localRoot, subFolder, ftpArray
Next
getFileList = ftpArray
End Function
The most efficient option would be to make a LDAP query to return a list of shared folders. This Sample Script from VBSEditor.com will do just that. This will require a fair amount of knowledge of your Active Directory.
Функция FilenamesCollection предназначена для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках.
Используется рекурсивный перебор папок, до заданного уровня вложенности.
В процессе перебора папок, пути у найденным файлам помещаются в коллекцию (объект типа Collection) для последующего перебора.
К статье прикреплено 2 примера файла с макросами на основе этой функции:
- Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки)
- Пример в файле FilenamesCollectionEx.xls более функционален – он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.
Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)
Смотрите также расширенную версию макроса на базе этой функции:
Макрос FolderStructure выводит в таблицу Excel список файлов и подпапок с отображением структуры (вложенности файлов и подпапок)
ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)
Внимание: если требуется, чтобы поиск не зависел от регистра символов в маске файла
(к примеру, обнаруживались не только файлы .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 ' © EducatedFool excelvba.ru/code/FilenamesCollection ' Получает в качестве параметра путь к папке 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
- 303056 просмотров
Не получается применить макрос? Не удаётся изменить код под свои нужды?
Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.
|
gena10111  Пользователь Сообщений: 125 |
Прошу помощи у форумчан! Переклинило при решении простой задачи: Как средствами VBA прописать код поиска папки с нужным именем (Вол_Кол) по указанному пути, например D:32.145ВСЁКП (то есть – наличие папки «Вол_Кол» в папке «КП»). Если такой папки нет – то ВЫХОД из макроса; если папка есть – то вывести сообщение «папка есть!». Заранее благодарен вам. |
|
ivanok_v2  Пользователь Сообщений: 712 |
#2 10.09.2018 10:19:01
Изменено: ivanok_v2 – 10.09.2018 10:20:09 |
||
|
RAN  Пользователь Сообщений: 7132 |
#3 10.09.2018 10:20:06
|
||
|
ivanok_v2 Пользователь Сообщений: 712 |
RAN, Изменено: ivanok_v2 – 10.09.2018 10:34:11 |
|
gena10111 Пользователь Сообщений: 125 |
Спасибо! RAN подскажите мне, как новичку, как Ваш код понять? ivanok_v2 есть к Вам вопрос: а данный код будет работать (искать папку) на любом ПК? То есть если я копирую файл с макросом и открываю на другом ПК, где указанный в вопросе путь конечно существует, то поиск будет осуществлен корректно? |
|
ivanok_v2 Пользователь Сообщений: 712 |
#6 10.09.2018 10:31:26
на виндовс – да
проверьте. Изменено: ivanok_v2 – 10.09.2018 10:33:45 |
||||
|
gena10111 Пользователь Сообщений: 125 |
Благодарю Вас! Уже пробую)) |
|
gena10111 Пользователь Сообщений: 125 |
#8 10.09.2018 11:38:56 Все работает, как часы! Еще раз благодарю за помощь! <#0> |
Содержание
- Практическое руководство. Поиск подкаталогов по шаблону в Visual Basic
- Поиск подкаталогов по заданному шаблону
- Отказоустойчивость
- Получение списка файлов в папке и подпапках средствами VBA
- Смотрите также расширенную версию макроса на базе этой функции:
- Комментарии
- Как реализовать поиск по Excel, чтобы искал во всех вложенных папках(подпапках)?
- 1 ответ 1
- Похожие
- Подписаться на ленту
Практическое руководство. Поиск подкаталогов по шаблону в Visual Basic
Метод GetDirectories возвращает доступную только для чтения коллекцию строк, представляющих имена путей к подкаталогам каталога. Для указания определенного шаблона можно использовать параметр wildCards . Если требуется включить в поиск содержимое подкаталогов, присвойте параметру searchType значение SearchOption.SearchAllSubDirectories .
Если каталоги, соответствующие указанному шаблону, не найдены, возвращается пустая коллекция.
Поиск подкаталогов по заданному шаблону
Используйте метод GetDirectories , указав имя и путь к каталогу для поиска. В следующем примере возвращаются все каталоги в структуре каталогов, имена которых содержат слово «Logs». Затем они добавляются в ListBox1 .
Отказоустойчивость
При следующих условиях возможно возникновение исключения:
Путь недопустим по одной из следующих причин: это строка нулевой длины, она содержит только пробелы, содержит недопустимые символы или путь к устройству (начинается с \.) (ArgumentException).
Путь не является допустимым, поскольку он равен Nothing (ArgumentNullException).
Один или несколько указанных подстановочных знаков являются Nothing , пустой строкой или содержат только пробелы (ArgumentNullException).
directory указывает на существующий файл (IOException).
Длина пути превышает максимальную длину, определенную в системе (PathTooLongException).
Имя файла или папки в пути содержит двоеточие (:) или имеет недопустимый формат (NotSupportedException).
У пользователя отсутствуют необходимые разрешения на просмотр пути (SecurityException).
У пользователя отсутствуют необходимые разрешения (UnauthorizedAccessException).
Источник
Получение списка файлов в папке и подпапках средствами VBA
Функция FilenamesCollection предназначена для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках.
Используется рекурсивный перебор папок, до заданного уровня вложенности.
В процессе перебора папок, пути у найденным файлам помещаются в коллекцию (объект типа Collection) для последующего перебора.
К статье прикреплено 2 примера файла с макросами на основе этой функции:
- Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки)
- Пример в файле FilenamesCollectionEx.xls более функционален — он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.
Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)
Смотрите также расширенную версию макроса на базе этой функции:
Макрос FolderStructure выводит в таблицу Excel список файлов и подпапок с отображением структуры (вложенности файлов и подпапок)
ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)
‘ Пример использования функции в макросе:
Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:
Ещё один пример использования:
PS: Найти подходящие имена файлов в коллекции можно при помощи следующей функции:
Комментарии
Не знаю что там за проблема с некорректными именами файлов, — я этот код использовал в сотнях макросов, эта функция работает в составе моих надстроек на десятках тысяч компьютеров, и никаких проблем не наблюдается.
И ни разу я не применял имена MS DOS..
Игорь, спасибо за рабочий пример (немного докрутил и использую в работе).
Что касается вопроса с некорректными именами файлов (которые не любит обрабатывать сей код (например, если в имени есть символ из непонятной кодировки)), выход нашел немного «топорный»: внутри обработки применяю имена MS DOS, которые обрабатываются нормально в большинстве случаев, а в интерфейсе делаю подмену имен на виндовые. Возможно не совсем понятно написал, но примера сейчас нет под рукой.
Спасибо автору, хороший код для поиска файлов, но возникает вопрос, а можно отключить отображение поиска внизу экселя?
Добрый день, а есть возможность применить свой макрос к полученному списку файлов?
Александр, нет таких полей у файлов произвольного формата, — потому, никак.
Посоветуйте пожалуйста как с помощью FSO получить доступ к полям Теги и Комментарии. Спасибо Alexander A. Rylov
Михаил, найдите в верхней части кода строку Option Explicit
и удалите её (эта строка требует объявлять переменные)
Подскажите. Почему excel может ругаться на
Set FSO = CreateObject(«Scripting.FileSystemObject») ‘ создаём экземпляр FileSystemObject
Пишет что переменная не объявлена/не определена
Нужно выше дописать
Dim FSO As Object?
Или в настройках excel 2016 что-то не так? Притом ругается на все не объявленные переменные.
А переменные типа Filename$ вообще не воспринимает как переменные. В чем может быть дело?
Гуглинг пока не помог.
Здравствуйте.
DoEvents никак не влияет на правильность работы (и не может повлиять)
А количество активных гиперссылок на листе Excel ограничено, — никак не сделать, чтобы на одном листе было более 50 или 65 тысяч АКТИВНЫХ гиперссылок.
Доброго времени суток. Огромное спасибо за программу!
Добавлю от себя и задам вопрос.
При использовании «DoEvents» программа может не правильно работать, в том числе выводить не все значения. Я ее закомментировал.
При привышении 65532 строк гиперссылки прекращают формироваться. Как можно победить?
Здравствуйте.
Под заказ что угодно могу сделать (платно)
Здравствуйте. Для примера из файла «FilenamesCollectionEx.xls» — можете сделать, чтобы выводимый на лист Excel список файлов был отсортирован по размеру(по уменьшению)?
Здравствуйте.
Могу сделать под заказ
Оформляйте заказ на сайте, и обязательно прикрепляйте пример файла с примером результата.
Здравствуйте! Меня тоже интересует макрос по поиску файлов. Можете сделать так что бы в ячейках к примеру A1 задать имя файла, A2 задать тип файла и A3 путь к папке?
Огромное Вам спасибо! Столько времени мне съэкономили.
СПА-СИ-БО! 🙂
Спасибо. Очень полезная вещь!
Здравствуйте, Юрий
Да, это можно исправить, — другой код нужен
(встроенные в VBA функции иногда дают ошибки)
Добрый день
В случае если в именах файлов встречаются нестандартные символы (допустимые в Win) макрос выдает ошибку
Ошибка в строке ДатаСоздания = FileDateTime(ПутьКФайлу)
Можно добавить onError Resume Next но это пропуск ошибки будет а размер файла не будет определен. Есть ли варианты сделать определение размера файлов и для таких файлов тоже?
Пример папки на которой сканирование папки «спотыкается»: https://bit.ly/2zz8Tfw
Игорь, подскажите, а можно ли в файл FilenamesCollectionEx.xls добавить маску имени подпапки, в которой производить поиск? Ситуация: файл с одинаковм именем может лежать в подпапках с разными именами. Я точно знаю, что нужная мне версия должна лежать в определенной подпапке. И проверять таким образом только их?
Так вроде и то и другое выводится
Код открыт ведь, — поменяйте как вам надо, если лишний столбец мешает.
Возможно я слепой или плохо читаю, но я не увидел что-то подобное в коментах. Поэтому мой вопрос следующий: можно как-то сделать так, чтобы выводило только название файла а не весь путь?
Отбой, разобрался. Виноват оказался не этот макрос, а тот, который его результаты использовал. Мораль — люди, не юзайте Dir, если вам нужно что-то сделать с папкой, к которой он обращается.
В моём макросе нет MoveFolder — так что мой макрос точно не виноват в вашей проблеме.
Проблема — либо в неверном использовании MoveFolder (не то или не туда перемещаете), либо нет прав доступа на перемещение в заданное место.
Игорь, всё это прекрасно. Непонятно только, что нужно сделать с Вашим макросом, чтобы после его вызова с папкой можно было бы ещё и что-нибудь сделать, например, переместить. Сейчас после вызова FSO.MoveFolder вылетает с ошибкой Access denied. Проверено, виноват именно Ваш макрос — если закомментировать ТОЛЬКО его вызов, FSO.MoveFolder отрабатывает нормально.
Спасибо, ОГРОМНОЕ.
Выручайте ребята! макрос в целом отличный, но для моих целе нужно немного переделать.
Нужно чтоб все файлы находящиеся в каждой папке были в одной ячейке через разделитель ( | )
Например:
C:images4-20161032g.jpg|C:images4-20161033g.jpg|C:images4-20161033g.jpg
Да, сделал.
Высылайте на почту подробное задание (что и как должно выглядеть, для чего это вообще нужно, и т.д.)
Тогда озвучу сроки и стоимость
Добрый день!
Скажите, пожалуйста, сделали ли вы макрос для Александра?
Если да, то за сколько его можно приобрести?
Если нет, то какие сроки выполнения?
Спасибо!
Напишите на почту стоимость и сроки выполнения
Александр, в этом случае нужен более сложный макрос.
Могу сделать под заказ.
Здравствуйте, Макрос хороший. Всё отлично выводит. Но как сделать дерево? Имеется несколько папок, далее нажимаешь на папку или плюс или еще что-то, она открывается, появляется подпапки, опять жмешь на подпапку появляются подпапки и т.д.
Спасибо, отличный макрос
В ответ на:
Андрей, 15 Мар 2018 — 15:13.#3
Добрый день.
файл 148 знаков (рус.буквы) не обрабатывается,
и сам файл на сервере (если файл на раб.столе то все работает)
какая максимальная длина имени и можно-ли ее обойти.
Ограничение на полное имя файла, включая расширение — 259 символов. Соответственно, все файлы, имеющие более длинное имя при выполнении
Set curfold = FSO.GetFolder(FolderPath)
будут проигнорированы. Тестировал на EX2010, W7 и MSServer 2008. У меня из 28 (curfold.Соunt) файлов реально в коллекции только 15 (curfold.items(1). curfold.items(15))
А как сделать макрос чтобы он мне показал только пустые папки?
Ограничений по длине имени файла, вроде как, нет (по крайней мере, за много лет использования этого кода на тысячах компов, с проблемами не сталкивался)
Добрый день.
файл 148 знаков (рус.буквы) не обрабатывается,
и сам файл на сервере (если файл на раб.столе то все работает)
какая максимальная длина имени и можно-ли ее обойти.
Адаптировал к access — все работает, спасибо, очень помогло
Ринат, посмотрите макрос обработки файлов из папки.
Там выводится диалоговое окно папки, и обрабатываются все файлы в ней (независимо от имён файлов)
Добрый день!
Такой вопрос, в отделе каждый месяц сотрудник ведет отчет по своей работе в табличной форме в ексель каждый в своем файле, а начальству необходимо данные отчеты ввести в свою итоговую таблицу для себя, то есть скопировать данные отчетов с файлов каждого сотрудника в свой отдельный файл. Я создал макрос, для скопирования данных с файлов каждого сотрудника в таблицу файла начальству указывая путь к каждому файлу. Но при этом возникает определенные неудобства, каждый месяц нужно пути к файлам прописывать заново, так как на следующий месяц создаются новые файлы по отчетам, и пути к ним необходимо обновлять. Подскажите пожалуйста, как можно сделать так, чтоб пути к файлам привязывались не по конкретному расположению файла, а например указыванием месяца и года можно было сформировать единый отчет на определенный месяц. Спасибо заранее!
Большое спасибо автору! Список использую для каталогизации архива сканов документов.
Да, можем сделать такой макрос под заказ.
Минимальная стоимость заказа 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й работают), хотя файл и макросы одни и те же. Знаете, в чем может быть причина?
Источник
Как реализовать поиск по Excel, чтобы искал во всех вложенных папках(подпапках)?
Имеется рабочий код поиска по множеству Excel-файлов, с выводом полного адреса в виде списка гиперссылок. Как реализовать поиск не только в одном уровне, но и во ВСЕХ вложенных подпапках, с возможностью либо отключения глубокого поиска, либо предупреждения что он включен(думается можно намертво повесить компьютер если выбрать слишком большой объём).
1 ответ 1
Нашлось в бардачке 🙂
К сожалению, имя автора не сохранилось.
Задействуется FSO (FileSystemObject). Создается коллекция имен всех найденных вложенных папок.
FolderPath — путь к исходной папке. Глубина поиска задается переменной SearchDeep. Созданный список папок можно посмотреть в Immediate Window.
С помощью Application.FileDialog задать исходную папку и использовать коллекцию перед строкой
Похожие
Подписаться на ленту
Для подписки на ленту скопируйте и вставьте эту ссылку в вашу программу для чтения RSS.
Дизайн сайта / логотип © 2023 Stack Exchange Inc; пользовательские материалы лицензированы в соответствии с CC BY-SA . rev 2023.3.17.43323
Нажимая «Принять все файлы cookie» вы соглашаетесь, что Stack Exchange может хранить файлы cookie на вашем устройстве и раскрывать информацию в соответствии с нашей Политикой в отношении файлов cookie.
Источник
Получение списка папок 1, 2 и 3 уровней вложенности с помощью кода VBA Excel. SubFolders — коллекция подпапок, расположенных в указанной папке.
Свойство SubFolders объекта Folder
SubFolders — это свойство объекта Folder, которое возвращает коллекцию подпапок, расположенных в указанной папке (Folder), включая скрытые и системные папки.
Обход папок разных уровней вложенности можно использовать не только для того, чтобы отобразить список папок на экране, но и для работы с находящимися в них файлами.
Список папок 1 уровня вложенности
Получение списка папок 1 уровня вложенности:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub ShowFolderSublevel1() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, s As String ‘Указываем адрес исходной папки s = “C:Users” ‘Создаем экземпляр FileSystemObject Set fso = CreateObject(“Scripting.FileSystemObject”) ‘Присваиваем переменной fo ссылку на указанную папку Set fo = fso.GetFolder(s) ‘Отключаем обработчик ошибок On Error Resume Next ‘Обходим циклом коллекцию подпапок в указанной папке For Each fo1 In fo.SubFolders ‘Печатаем полное имя текущей подпапки в окне Immediate Debug.Print fo1 ‘.Path – по умолчанию Next ‘Включаем обработчик ошибок On Error GoTo 0 End Sub |
Если в исходной папке нет подпапок, то применение свойства SubFolders вызовет ошибку. Чтобы пропускать такие ошибки, мы отключаем обработчик ошибок на время работы циклов.
Список папок 2 уровня вложенности
Получение списка папок 1 и 2 уровней вложенности:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
Sub ShowFolderSublevel2() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, fo2 As Folder, s As String s = “C:Users” Set fso = CreateObject(“Scripting.FileSystemObject”) Set fo = fso.GetFolder(s) On Error Resume Next ‘Обходим коллекцию подпапок 1 уровня вложенности For Each fo1 In fo.SubFolders Debug.Print fo1 ‘Обходим коллекцию подпапок 2 уровня вложенности For Each fo2 In fo1.SubFolders ‘Перед полным именем подпапки 2 уровня добавляем 4 пробела Debug.Print Space(4) & fo2 Next Next On Error GoTo 0 End Sub |
Список папок 3 уровня вложенности
Получение списка папок 1, 2 и 3 уровней вложенности:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub ShowFolderSublevel3() Dim fso As FileSystemObject, fo As Folder, fo1 As Folder, fo2 As Folder, fo3 As Folder, s As String s = “C:Users” Set fso = CreateObject(“Scripting.FileSystemObject”) Set fo = fso.GetFolder(s) On Error Resume Next ‘Обходим коллекцию подпапок 1 уровня вложенности For Each fo1 In fo.SubFolders Debug.Print fo1 ‘Обходим коллекцию подпапок 2 уровня вложенности For Each fo2 In fo1.SubFolders ‘Перед полным именем подпапки 2 уровня добавляем 4 пробела Debug.Print Space(4) & fo2 ‘Обходим коллекцию подпапок 3 уровня вложенности For Each fo3 In fo2.SubFolders ‘Перед полным именем подпапки 3 уровня добавляем 8 пробелов Debug.Print Space(8) & fo3 Next Next Next On Error GoTo 0 End Sub |
Обратите внимание, если вы будете использовать для тестов папку «C:Users» как исходную, все строки с наименованиями подпапок в окне Immediate не уместятся (ограничение — 200 строк).
Как получить список файлов в папке, смотрите в статье VBA Excel. Список файлов в папке.
Фразы для контекстного поиска: вложенная папка, вложенные папки, список подпапок, обход подпапок, вывод списка.
