Функция 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
- 301790 просмотров
Не получается применить макрос? Не удаётся изменить код под свои нужды?
Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.
Добрый день! Подскажите пожалуйста, где я ошибаюсь. Задача следующаяя: имеются файлы, которые эксель определяет. В этих файлах хранится текстовая информация. В главном файле задается критерий для поиска и кноркой активируется поиск, после чего найденные записи по всем файлам выводятся на лист главного. Но при поиске он ищет почему-то только в самом себе, а не в нужных.
200?’200px’:»+(this.scrollHeight+5)+’px’);»>
Private Sub CommandButton1_Click()
ТекстДляПоиска = «ант»
[c1] = «C:UsersАдминистраторDesktopГУН»
‘ Ищем файлы в заданной папке по заданной маске,
‘ и выводим на лист список их параметров.
‘ Просматриваются папки с заданной глубиной вложения.
Dim coll As Collection, FolderPath$, searchmask$, searchdepth%
On Error Resume Next
FolderPath$ = [c1] ‘ берм из ячейки c1
searchmask$ = «*.*xl*» ‘ берм из ячейки c2
searchdepth% = 1 ‘ берм из ячейки c3
If searchdepth% = 0 Then searchdepth% = 999 ‘ без ограничения по глубине
‘ считываем в колекцию coll нужные имена файлов
Set coll = FilenamesCollection(FolderPath$, searchmask$, searchdepth%)
Application.ScreenUpdating = False ‘ отключаем обновление экрана
‘ выводим результаты (список файлов, и их характеристик) на лист
For i = 1 To coll.Count ‘ перебираем все элементы коллекции, содержащей пути к файлам
filenumber = i
pathtothefile = coll(i)
Filename = Dir(pathtothefile)
creationdate = FileDateTime(pathtothefile)
filesize = FileLen(pathtothefile)
filesize = FileOrFolderSize(filesize)
‘——————————————————————
ТекстДляПоиска = «*» & «ант» & «*»
Set СписокНомеровНайденныхСтрок = New Collection
On Error Resume Next ‘ отключаем останов при ошибке
Workbooks.Open Filename:=pathtothefile
Workbooks(pathtothefile).Activate
With ThisWorkbook.Worksheets(«Лист1»)
‘——————————————————————
ПоследняяСтрокаБД = .Range(«a» & .Rows.Count).End(xlUp).Row ‘ вычисляем номер последней строки
Dim РезультатПоиска As Range, АдресПервойНайденнойЯчейки As String
Set РезультатПоиска = Cells.Find(ТекстДляПоиска, LookAt:=xlPart) ‘ начинаем поиск
If Not РезультатПоиска Is Nothing Then ‘ если нашли хоть одну подходящую ячейку
АдресПервойНайденнойЯчейки = РезультатПоиска.Address ‘ запоминаем Адрес Первой Найденной Ячейки
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
Do
‘ ищем следующую ячейку
Set РезультатПоиска = Cells.FindNext(РезультатПоиска)
If Not РезультатПоиска Is Nothing Then ‘ если нашли очередную подходящую ячейку
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
End If
‘ повторяем поиск до тех пор, пока не дойдм до Первой Найденной Ячейки
Loop While РезультатПоиска.Address <> АдресПервойНайденнойЯчейки
End If
‘——————————————————————
End With
ActiveWorkbook.Close False
On Error GoTo 0 ‘ отключение режима пропуска ошибок
‘——————————————————————
Range(«a» & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
Array(filenumber, Filename, pathtothefile, creationdate, filesize)
‘ если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range(«b» & Rows.Count).End(xlUp), pathtothefile, «», _
«Открыть файл» & vbNewLine & Filename
On Error GoTo 0
Range(«a:e»).EntireColumn.AutoFit ‘ автоподбор ширины столбцов
End Sub
Заранее благодарен. Просьба не судить за русскоязычные переменные, знаю что это не правильно.
[moder]Оформите код тегами (кнопка #)[/moder]
Добрый день! Подскажите пожалуйста, где я ошибаюсь. Задача следующаяя: имеются файлы, которые эксель определяет. В этих файлах хранится текстовая информация. В главном файле задается критерий для поиска и кноркой активируется поиск, после чего найденные записи по всем файлам выводятся на лист главного. Но при поиске он ищет почему-то только в самом себе, а не в нужных.
200?’200px’:»+(this.scrollHeight+5)+’px’);»>
Private Sub CommandButton1_Click()
ТекстДляПоиска = «ант»
[c1] = «C:UsersАдминистраторDesktopГУН»
‘ Ищем файлы в заданной папке по заданной маске,
‘ и выводим на лист список их параметров.
‘ Просматриваются папки с заданной глубиной вложения.
Dim coll As Collection, FolderPath$, searchmask$, searchdepth%
On Error Resume Next
FolderPath$ = [c1] ‘ берм из ячейки c1
searchmask$ = «*.*xl*» ‘ берм из ячейки c2
searchdepth% = 1 ‘ берм из ячейки c3
If searchdepth% = 0 Then searchdepth% = 999 ‘ без ограничения по глубине
‘ считываем в колекцию coll нужные имена файлов
Set coll = FilenamesCollection(FolderPath$, searchmask$, searchdepth%)
Application.ScreenUpdating = False ‘ отключаем обновление экрана
‘ выводим результаты (список файлов, и их характеристик) на лист
For i = 1 To coll.Count ‘ перебираем все элементы коллекции, содержащей пути к файлам
filenumber = i
pathtothefile = coll(i)
Filename = Dir(pathtothefile)
creationdate = FileDateTime(pathtothefile)
filesize = FileLen(pathtothefile)
filesize = FileOrFolderSize(filesize)
‘——————————————————————
ТекстДляПоиска = «*» & «ант» & «*»
Set СписокНомеровНайденныхСтрок = New Collection
On Error Resume Next ‘ отключаем останов при ошибке
Workbooks.Open Filename:=pathtothefile
Workbooks(pathtothefile).Activate
With ThisWorkbook.Worksheets(«Лист1»)
‘——————————————————————
ПоследняяСтрокаБД = .Range(«a» & .Rows.Count).End(xlUp).Row ‘ вычисляем номер последней строки
Dim РезультатПоиска As Range, АдресПервойНайденнойЯчейки As String
Set РезультатПоиска = Cells.Find(ТекстДляПоиска, LookAt:=xlPart) ‘ начинаем поиск
If Not РезультатПоиска Is Nothing Then ‘ если нашли хоть одну подходящую ячейку
АдресПервойНайденнойЯчейки = РезультатПоиска.Address ‘ запоминаем Адрес Первой Найденной Ячейки
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
Do
‘ ищем следующую ячейку
Set РезультатПоиска = Cells.FindNext(РезультатПоиска)
If Not РезультатПоиска Is Nothing Then ‘ если нашли очередную подходящую ячейку
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
End If
‘ повторяем поиск до тех пор, пока не дойдм до Первой Найденной Ячейки
Loop While РезультатПоиска.Address <> АдресПервойНайденнойЯчейки
End If
‘——————————————————————
End With
ActiveWorkbook.Close False
On Error GoTo 0 ‘ отключение режима пропуска ошибок
‘——————————————————————
Range(«a» & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
Array(filenumber, Filename, pathtothefile, creationdate, filesize)
‘ если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range(«b» & Rows.Count).End(xlUp), pathtothefile, «», _
«Открыть файл» & vbNewLine & Filename
On Error GoTo 0
Range(«a:e»).EntireColumn.AutoFit ‘ автоподбор ширины столбцов
End Sub
Заранее благодарен. Просьба не судить за русскоязычные переменные, знаю что это не правильно.
[moder]Оформите код тегами (кнопка #)[/moder] scofield
Сообщение Добрый день! Подскажите пожалуйста, где я ошибаюсь. Задача следующаяя: имеются файлы, которые эксель определяет. В этих файлах хранится текстовая информация. В главном файле задается критерий для поиска и кноркой активируется поиск, после чего найденные записи по всем файлам выводятся на лист главного. Но при поиске он ищет почему-то только в самом себе, а не в нужных.
200?’200px’:»+(this.scrollHeight+5)+’px’);»>
Private Sub CommandButton1_Click()
ТекстДляПоиска = «ант»
[c1] = «C:UsersАдминистраторDesktopГУН»
‘ Ищем файлы в заданной папке по заданной маске,
‘ и выводим на лист список их параметров.
‘ Просматриваются папки с заданной глубиной вложения.
Dim coll As Collection, FolderPath$, searchmask$, searchdepth%
On Error Resume Next
FolderPath$ = [c1] ‘ берм из ячейки c1
searchmask$ = «*.*xl*» ‘ берм из ячейки c2
searchdepth% = 1 ‘ берм из ячейки c3
If searchdepth% = 0 Then searchdepth% = 999 ‘ без ограничения по глубине
‘ считываем в колекцию coll нужные имена файлов
Set coll = FilenamesCollection(FolderPath$, searchmask$, searchdepth%)
Application.ScreenUpdating = False ‘ отключаем обновление экрана
‘ выводим результаты (список файлов, и их характеристик) на лист
For i = 1 To coll.Count ‘ перебираем все элементы коллекции, содержащей пути к файлам
filenumber = i
pathtothefile = coll(i)
Filename = Dir(pathtothefile)
creationdate = FileDateTime(pathtothefile)
filesize = FileLen(pathtothefile)
filesize = FileOrFolderSize(filesize)
‘——————————————————————
ТекстДляПоиска = «*» & «ант» & «*»
Set СписокНомеровНайденныхСтрок = New Collection
On Error Resume Next ‘ отключаем останов при ошибке
Workbooks.Open Filename:=pathtothefile
Workbooks(pathtothefile).Activate
With ThisWorkbook.Worksheets(«Лист1»)
‘——————————————————————
ПоследняяСтрокаБД = .Range(«a» & .Rows.Count).End(xlUp).Row ‘ вычисляем номер последней строки
Dim РезультатПоиска As Range, АдресПервойНайденнойЯчейки As String
Set РезультатПоиска = Cells.Find(ТекстДляПоиска, LookAt:=xlPart) ‘ начинаем поиск
If Not РезультатПоиска Is Nothing Then ‘ если нашли хоть одну подходящую ячейку
АдресПервойНайденнойЯчейки = РезультатПоиска.Address ‘ запоминаем Адрес Первой Найденной Ячейки
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
Do
‘ ищем следующую ячейку
Set РезультатПоиска = Cells.FindNext(РезультатПоиска)
If Not РезультатПоиска Is Nothing Then ‘ если нашли очередную подходящую ячейку
НомерСтроки = РезультатПоиска.Row ‘ получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ‘ записываем номер строки в список
End If
‘ повторяем поиск до тех пор, пока не дойдм до Первой Найденной Ячейки
Loop While РезультатПоиска.Address <> АдресПервойНайденнойЯчейки
End If
‘——————————————————————
End With
ActiveWorkbook.Close False
On Error GoTo 0 ‘ отключение режима пропуска ошибок
‘——————————————————————
Range(«a» & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
Array(filenumber, Filename, pathtothefile, creationdate, filesize)
‘ если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range(«b» & Rows.Count).End(xlUp), pathtothefile, «», _
«Открыть файл» & vbNewLine & Filename
On Error GoTo 0
Range(«a:e»).EntireColumn.AutoFit ‘ автоподбор ширины столбцов
End Sub
Заранее благодарен. Просьба не судить за русскоязычные переменные, знаю что это не правильно.
[moder]Оформите код тегами (кнопка #)[/moder] Автор — scofield
Дата добавления — 28.09.2015 в 11:29
Источник
Adblock
detector
Как правильно вызвать окно проводника, чтобы вывести список файлов определенного расширения? Попытался использовать следующий код, но выводит только окно поиска. |
|
Слэн Пользователь Сообщений: 5192 |
#2 22.11.2013 14:08:15
например Живи и дай жить.. |
||
Ёк-Мок Пользователь Сообщений: 1775 |
#3 22.11.2013 14:16:45 или
Удивление есть начало познания © Surprise me! |
||
The_Prist Пользователь Сообщений: 14182 Профессиональная разработка приложений для MS Office |
Просмотреть все файлы в папке Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы… |
Мне нужно вывести окно проводника с результатом поиска. Если я использую CreateObject(«Shell.Application»).FindFiles, выводиться пустое окно, т.к. не заданы аргументы для поиска (Искомые файлы, папка поиска). |
|
SkyPro Пользователь Сообщений: 309 |
#6 22.11.2013 14:57:07
Не получится. У FindFiles нет аргументов. Это просто запуск окна поиска. SkyPro |
||
Николай Шелковников Пользователь Сообщений: 123 |
#7 22.11.2013 15:48:41 Нашел похожую процедуру.
|
||
ikki Пользователь Сообщений: 9709 |
Изменено: ikki — 22.11.2013 16:06:43 фрилансер Excel, VBA — контакты в профиле |
Когда работаю с аргументом find, выводится ошибка «No association for file extension». В остальных случаях находит указанный файл (explore, open, edit, print), но с маской *.txt не работает. Как правильно задать аргументы? |
|
Юрий М Модератор Сообщений: 60575 Контакты см. в профиле |
А чем не устраивает вариант Слэна? |
SkyPro Пользователь Сообщений: 309 |
Подозреваю, что суть в использовании виндовского окна поиска. Изменено: SkyPro — 22.11.2013 20:21:14 |
Да, необходимо вызвать окно проводника для поиска файлов |
|
Юрий М Модератор Сообщений: 60575 Контакты см. в профиле |
Окно проводника и окно поиска — разные вещи. |
Мне нужно окно вызываемое вот этим кодом Set oFnd = CreateObject(«Shell.Application»).FindFiles |
|
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
#15 23.11.2013 11:58:46 Как вариант, не без проблем (ниже почему). Нужно подключить бибилиотеку Miscrosoft Shell Controls and Automation.
|
||
Библиотеку подключил, на строке shFolderView.FilterView «*.txt« выдает ошибку: «Object doesn´t support this property or method». |
|
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
Я тестировал в win7 64bit, Excel 2010 32bit. Если у вас win xp… насколько помню, там поиск файлов не входил в состав проводника. Посмотреть смогу только в понедельник. Изменено: anvg — 23.11.2013 16:58:10 |
В нашей организации сотрудники привыкли искать отсканированные документы через проводник. |
|
ikki Пользователь Сообщений: 9709 |
#19 23.11.2013 18:09:37
имхо : у сотрудников в вашей организации сложились плохие привычки. у данного типа задач есть гораздо более приятные и «вкусные» варианты решения. хотя, конечно. хозяин — барин… фрилансер Excel, VBA — контакты в профиле |
||
Все это реализовано, но для тех кто не хочет менять привычки хочу сделать поиск через проводник. |
|
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
#21 23.11.2013 18:24:25
существуют дисциплинарные взыскания(например для Украины- Кзот): Я сам — дурнее всякого примера! … |
||
ikki Пользователь Сообщений: 9709 |
#22 23.11.2013 18:27:01
кстати, да. но в реальной жизни бывают исключения — «большие» начальники. фрилансер Excel, VBA — контакты в профиле |
||
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
Точно, Саш. Но! «»большие» начальники» в большинстве своем малосведущи в Эксе, ВБА и иже.. И если авторитетный в той организации знаток Экса скажет: «А низзя! И чревато!», то в подавляющем числе случаев получится см. пост №21[IMG] Я сам — дурнее всякого примера! … |
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
В WinXP как то всё сложно. Может и Find по-умолчанию и Windows Desktop Search выскочить при использовании CreateObject(«Shell.Application»).FindFiles (в зависимости что стоит). Изменено: anvg — 25.11.2013 03:28:54 |
У меня стоит WinXP, по умолчанию запускается Find. |
|
Николай Шелковников Пользователь Сообщений: 123 |
#26 27.11.2013 15:42:21 Без вариантов? |
Получение списка файлов в указанной папке с помощью кода 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. Список папок.
Фразы для контекстного поиска: обход файлов.
0 / 0 / 0 Регистрация: 08.10.2015 Сообщений: 15 |
|
1 |
|
Поиск в папках и подпапках24.04.2016, 23:29. Показов 14323. Ответов 9
Здравствуйте! Делаю курсовую на VBA и к сожалению только на нём. По моей задумке мне надо вывести в файл все файлы и папки, а так же все файлы в подпапках и подпапки. Смог вывести только то что в начальной папке и её подпапках(2 уровень), пользуясь dir. Пробовал писать рекурсию, но тогда начинаются проблемы с путями для dir из-за разветвления. Посоветуйте в каком направлении идти, в интернете искал, очень много нашёл всяких конструкций для VB, но мне надо именно на VBA (MS Office Excel 2003).
0 |
5 / 5 / 2 Регистрация: 12.03.2016 Сообщений: 10 |
|
25.04.2016, 02:59 |
2 |
Отлично работает рекурсия с функцией Dir(), буквально пару часов назад открывал макрос, осуществляющий обход каталогов посредством этой функции. Есть ещё вот такая вещь для работы с файловой системой в VBA — FileSystemObject.
0 |
Alex77755 11482 / 3773 / 677 Регистрация: 13.02.2009 Сообщений: 11,145 |
||||
25.04.2016, 09:41 |
3 |
|||
2 |
Заблокирован |
|
25.04.2016, 10:28 |
4 |
Отлично работает рекурсия с функцией Dir(), … осуществляющий обход каталогов Кодом не поделитесь?
0 |
5 / 5 / 2 Регистрация: 12.03.2016 Сообщений: 10 |
|
25.04.2016, 13:55 |
5 |
Кодом не поделитесь? Ну собственно с «костылями» видимо и у меня; насколько я помню собирал каталоги в строку, разделяя их «/», и передавал эту строку в эту же функцию.
0 |
Gunjy 5 / 5 / 2 Регистрация: 12.03.2016 Сообщений: 10 |
||||||
25.04.2016, 23:55 |
6 |
|||||
Сообщение было отмечено MIHAIL_WAS как решение Решение
Вложения
3 |
5561 / 1367 / 150 Регистрация: 08.02.2009 Сообщений: 4,107 Записей в блоге: 30 |
|
26.04.2016, 00:12 |
7 |
Есть готовый Excel-проект, но без рекурсивного углубления в подпапки. Пригодится? Миниатюры
0 |
Заблокирован |
||||||||
26.04.2016, 09:10 |
8 |
|||||||
Сообщение было отмечено MIHAIL_WAS как решение РешениеПара уточнений, если позволите.
— если начнете с корневой («C:» к примеру) папки, то пропустите два ни в чем неповинных файла (или папки).
Dir Path & «*.*», vbDirectory ‘skip «.» — будут пропущены все только_для_чтения, скрытые и(ли) системные файлы и папки. В итоге —
Примерно такие костыли я и делал в своё время, пока не остановился на FSO.
1 |
0 / 0 / 0 Регистрация: 08.10.2015 Сообщений: 15 |
|
26.04.2016, 17:01 [ТС] |
9 |
Всем спасибо, разобрался.
0 |
RadioBoTt 0 / 0 / 0 Регистрация: 05.05.2017 Сообщений: 12 |
||||
18.11.2019, 08:51 |
10 |
|||
Отлично работает рекурсия с функцией Dir(), буквально пару часов назад открывал макрос, осуществляющий обход каталогов посредством этой функции. Есть ещё вот такая вещь для работы с файловой системой в VBA — FileSystemObject. Пробую функцию на основании Dir (). Все получилось, список каталогов и файлов перебирается. Пытаюсь присвоить функции массив строковых данных (адреса файлов) и сделать вывод. Не получается никак. Дает ошибку диапазона значений.
0 |
Поиск по файлам |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
I wrote a vba code that browse all path folder and search for «strings.xml» file.
Dim oFS As Office.FileSearch
Dim i As Integer
Set oFS = Application.FileSearch
With oFS
.NewSearch
.FileType = msoFileTypeAllFiles
.Filename = "strings.xml"
.LookIn = "D:Workspace"
.SearchSubFolders = True
.Execute
MsgBox "Finish ! " & .FoundFiles.Count & " item found !"
End With
However, in my workspace I have many «strings.xml» files that this current code locates and but I only want to find the «strings.xml» within a specific subfolder; e.g. ./values/strings.xml
files.
asked Mar 11, 2013 at 12:49
1
The following will look recursively under your root working folder for ValuesStrings.xml
matches and list them in a Scripting.Dictionary object.
The main file/folder search is performed by the simple Dir function.
Sub dir_ValuesStringsXML_list()
Dim f As Long, ff As String, fp As String, fn As String, tmp As String
Dim vfn As Variant, dFILEs As Object 'New scripting_dictionary
Set dFILEs = CreateObject("Scripting.Dictionary")
dFILEs.CompareMode = vbTextCompare
'set vars for c:tempWorkspace*ValuesStrings.xml
fp = Environ("TMP") & Chr(92) & "Workspace"
ff = "Values"
fn = "Strings.xml"
dFILEs.Item(fp) = 0
'get folder list
Do
f = dFILEs.Count
For Each vfn In dFILEs
If Not CBool(dFILEs.Item(vfn)) Then
tmp = Dir(vfn & Chr(92) & Chr(42), vbDirectory)
Do While CBool(Len(tmp))
If Not CBool(InStr(1, tmp, Chr(46))) Then
dFILEs.Item(vfn & Chr(92) & tmp) = 0
End If
tmp = Dir
Loop
'Debug.Print dFILEs.Count
dFILEs.Item(vfn) = 1
End If
Next vfn
Loop Until f = dFILEs.Count
'remove the folders and check for ValuesStrings.xml
For Each vfn In dFILEs
If CBool(dFILEs.Item(vfn)) Then
If LCase(Split(vfn, Chr(92))(UBound(Split(vfn, Chr(92))))) = LCase(ff) And _
CBool(Len(Dir(vfn & Chr(92) & fn, vbReadOnly + vbHidden + vbSystem))) Then
dFILEs.Item(vfn & Chr(92) & fn) = 0
End If
dFILEs.Remove vfn
End If
Next vfn
'list the files
For Each vfn In dFILEs
Debug.Print "from dict: " & vfn
Next vfn
dFILEs.RemoveAll: Set dFILEs = Nothing
End Sub
If you wish to convert the late binding of the Scripting.Dictionary to early binding, you must add Microsoft Scripting Runtime to the VBE’s Tools ► References.
answered Feb 6, 2016 at 10:04
I think you are saying that you want to look in the sub-folder «values» for files called strings.xms
If that’s right, try the below amended code:
Dim oFS As Office.FileSearch
Dim i As Integer
Set oFS = Application.FileSearch
With oFS
.NewSearch
.FileType = msoFileTypeAllFiles
.Filename = "strings.xml"
.LookIn = "D:Workspacevalues"
.SearchSubFolders = True
.Execute
MsgBox "Finish ! " & .FoundFiles.Count & " item found !"
End With
of course, you may not want to specify the sub-folder.
Here is another option:
Dim sPath As String
Dim sFil As String
Dim strName As String
sPath = "D:Workspacevalues" 'Change Path
sFil = Dir(sPath & "string.xml") 'All files in Directory matching name
Do While sFil <> ""
strName = sPath & sFil
sFil = Dir
'Your Code Here.
i=i+1
Loop
MsgBox "Finish ! " & .FoundFiles.Count & " item found !"
Have you considered using the FileSystemObject to do a recursive search in a sub-folder only?
MSDN — How to do a recursive search using the FileSystemObject
HTH
Philip
answered Mar 11, 2013 at 13:05
2
replace:
sPath = "D:Workspacevalues" 'Change Path
sFil = Dir(sPath & "string.xml") 'All files in Directory matching name
with:
sPath = "D:Workspacevalues" 'Change Path
sFil = Dir(sPath & "*.xl*") 'All files in Directory matching name
Baby Groot
4,62739 gold badges53 silver badges71 bronze badges
answered Jan 16, 2014 at 8:22
Return to VBA Code Examples
In this tutorial, you will learn how to get names of all files in a folder and put them into a Worksheet.
Instead, if you want to learn how to check if a file exists, you can click on this link: VBA File Exists
Using the FileSystemObject to Get the List of Files in a Folder
VBA allows you to list all files from a folder, using the FileSystemObject.
We will show how to get a list of files in the folder C:VBA Folder and put it into the first column of the Worksheet. This folder consists of 5 files, as shown in Image 1:
Image 1. Files in folder C:VBA Folder
Here is the code:
Sub LoopThroughFiles ()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:VBA Folder")
For Each oFile In oFolder.Files
Cells(i + 1, 1) = oFile.Name
i = i + 1
Next oFile
End Sub
In the example, first create an object of the class Scripting.FileSystemObject:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Then set the folder using the method GetFolder:
Set oFolder = oFSO.GetFolder("C:VBA Folder")
Next loop through each file in oFolder, using oFile.Name to get the name of every file in the folder and write it in the next empty row:
For Each oFile In oFolder.Files
Cells(i + 1, 1) = oFile.Name
i = i + 1
Next oFile
Image 2. Worksheet with the list of files in the folder
As you can see in Image 2, all 5 files from the C:VBA Folder are listed in the first column.
VBA Coding Made Easy
Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!
Learn More!