Vba excel поиск всех файлов

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

Функция 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

 

Как правильно вызвать окно проводника, чтобы вывести список файлов определенного расширения?
Например: Ищем все файлы с расширением txt на диске C:/

Попытался использовать следующий код, но выводит только окно поиска.
Не знаю как правильно подставить аргументы
Set oFnd = CreateObject(«Shell.Application»).FindFiles

 

Слэн

Пользователь

Сообщений: 5192
Регистрация: 16.01.2013

#2

22.11.2013 14:08:15

Код
Dim dlg As FileDialog, rez
 Set dlg = Application.FileDialog(msoFileDialogFilePicker)
 dlg.AllowMultiSelect = False
 dlg.Title = "Укажите файл для обработки"
 dlg.InitialFileName = "*.txt"
 rez = dlg.Show

например

Живи и дай жить..

 

Ёк-Мок

Пользователь

Сообщений: 1775
Регистрация: 16.01.2013

#3

22.11.2013 14:16:45

или

Код
Dim sFile As String
sFile = Application.GetOpenFilename("Files(*.txt),*.txt", , "Выбрать файл", , Files)

Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.

 

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Просмотреть все файлы в папке

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Мне нужно вывести окно проводника с результатом поиска.

Если я использую CreateObject(«Shell.Application»).FindFiles, выводиться пустое окно, т.к. не заданы аргументы для поиска (Искомые файлы, папка поиска).

 

SkyPro

Пользователь

Сообщений: 309
Регистрация: 23.07.2013

#6

22.11.2013 14:57:07

Цитата
Мне нужно вывести окно проводника с результатом поиска.

Не получится. У FindFiles нет аргументов. Это просто запуск окна поиска.

SkyPro

 

Николай Шелковников

Пользователь

Сообщений: 123
Регистрация: 01.01.1970

#7

22.11.2013 15:48:41

Нашел похожую процедуру.
Помогите расшифровать аргументы и добавить поиск файлов по маске *.txt

Код
Option Explicit
'API declaration for the windows "Search Results" dialog
Private Declare Function ShellSearch& Lib "shell32.dll" _
        Alias "ShellExecuteA" (ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long)
        
Private Const SW_SHOWNORMAL = 1


Sub ShowWindowsSearchDialog_API()
'   Specified drive to Search
    Const szSDrive As String = "C:"
    
    ShellSearch 0, "find", szSDrive, "", "", SW_SHOWNORMAL
End Sub
 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

Изменено: ikki22.11.2013 16:06:43

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

Когда работаю с аргументом find, выводится ошибка  «No association for file extension».  В остальных случаях находит  указанный файл (explore,  open,  edit, print), но с маской *.txt не работает.

Как правильно задать аргументы?

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

А чем не устраивает вариант Слэна?

 

SkyPro

Пользователь

Сообщений: 309
Регистрация: 23.07.2013

Чилавеку нужна именна акно поиска вендовскае.

Подозреваю, что суть в использовании виндовского окна поиска.

Изменено: SkyPro22.11.2013 20:21:14

 

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

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

Окно проводника и окно поиска — разные вещи.

 

Мне нужно окно вызываемое вот этим кодом Set oFnd = CreateObject(«Shell.Application»).FindFiles

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

#15

23.11.2013 11:58:46

Как вариант, не без проблем (ниже почему). Нужно подключить бибилиотеку Miscrosoft Shell Controls and Automation.

Код
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Public Sub ShowFilteredWindow()
    Const FolderPath As String = "c:projects"
    Dim pShell As New Shell32.Shell
    Dim pWin As Object, shFolderView As Shell32.ShellFolderView
    Dim pFolder As Shell32.Folder3
    
    Set pFolder = pShell.Namespace(FolderPath)
    pShell.Explore FolderPath
    Sleep 200
    For Each pWin In pShell.Windows
        Set shFolderView = pWin.document
        'узкое место, такая папка в проводнике может быть открыта не один раз
        If shFolderView.Folder.Title = pFolder.Title Then
            shFolderView.FilterView "*.txt"
        End If
    Next
End Sub
 

Библиотеку подключил, на строке shFolderView.FilterView «*.txt« выдает ошибку: «Object doesn´t support this property or method».

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

Я тестировал в win7 64bit, Excel 2010 32bit. Если у вас  win xp… насколько помню, там поиск файлов не входил в состав проводника. Посмотреть смогу только в понедельник.
Простите за любопытство, но зачем нужно использовать именно проводник?

Изменено: anvg23.11.2013 16:58:10

 

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

 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

#19

23.11.2013 18:09:37

Цитата
В нашей организации сотрудники привыкли

имхо

: у сотрудников в вашей организации сложились плохие привычки. у данного типа задач есть гораздо более приятные и «вкусные» варианты решения.
раз уж у вас есть реестр в Excel и соответствующие файлы с текстами, то гораздо проще. правильнее и удобнее организовать гиперссылки из этого самого реестра на эти самые файлы.
правда, место хранения файлов желательно организовать правильно, раз и навсегда — например, разложить по папкам-контрагентам или датам или ответственным сотрудникам и т.д.
если же и это невозможно и ваши сотрудники «привыкли» таскать файлы туда-сюда — то и это не такая уж большая проблема, особенно в случае наличия какой-либо системы в наименованиях таких файлов — обычный поиск средствами VBA с этим справится достаточно легко.

хотя, конечно. хозяин — барин… ;)

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

Все это реализовано, но для тех кто не хочет менять привычки хочу сделать поиск через проводник.

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#21

23.11.2013 18:24:25

Цитата
для тех кто не хочет менять привычки

существуют дисциплинарные взыскания(например для Украины- Кзот):
1) Выговор;
2) Увольнение.
Думаю, уже после первого все дружно «захотят»! Если кто дождется второго, то на его место того, кто хочет. У себя дома пусть хотят. На работе надо работать.

Я сам — дурнее всякого примера! …

 

ikki

Пользователь

Сообщений: 9709
Регистрация: 22.12.2012

#22

23.11.2013 18:27:01

Цитата
На работе надо работать.

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

но в реальной жизни бывают исключения — «большие» начальники. :(

фрилансер Excel, VBA — контакты в профиле
«Совершенствоваться не обязательно. Выживание — дело добровольное.» Э.Деминг

 

KuklP

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

Точно, Саш. Но! «»большие» начальники» в большинстве своем малосведущи в Эксе, ВБА и иже.. И если авторитетный в той организации знаток Экса скажет: «А низзя! И чревато!», то в подавляющем числе случаев получится см. пост №21[IMG]
На самом деле, в бытность мою инженером, девчата(моего возраста и старше) дружили со мной, чтоб я им помогал не учиться информационным технологиям. Я писал им программки, иногда выполнял их работу. Но это было в 1999-2001гг. Делаем выводы, время не стоит и работодатели не хотят заниматься благотворительностью на собственных производствах. Да и талантливой(и при этом невостребованной) молодежи хватает. Поэтому считаю пост №21 не противоречащим нормальной, человеческой морали.

Я сам — дурнее всякого примера! …

 

anvg

Пользователь

Сообщений: 11878
Регистрация: 22.12.2012

Excel 2016, 365

В WinXP как то всё сложно. Может и Find по-умолчанию и Windows Desktop Search выскочить при использовании CreateObject(«Shell.Application»).FindFiles (в зависимости что стоит).
Так что, может вам проще сделать форму с ListBox с двумя колонками, в первую видимую выводить имена файлов, а в скрытой колонке хранить путь и имена файлов, и по щелчку на имени файла открывать его в блокноте, организовав поиск файлов по заданному пути через тот же Dir?

Изменено: anvg25.11.2013 03:28:54

 

У меня стоит WinXP, по умолчанию запускается  Find.

 

Николай Шелковников

Пользователь

Сообщений: 123
Регистрация: 01.01.1970

#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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Комманда1_Click()
 Dim FSO As Object
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Search FSO.GetFolder("D:")
End Sub
 
 Sub Search(Fold As Object)
 Dim SubFold As Object, Fil As Object
   Debug.Print Fold
   On Error GoTo ErrHandle
   For Each SubFold In Fold.SubFolders
     Search SubFold
   Next SubFold
   For Each Fil In Fold.Files
        Debug.Print Fil
   Next Fil
   Exit Sub
ErrHandle:
   MsgBox "Нет допуска к папке """ & Fold.Path & """"
   Err.Clear
End Sub



2



Shersh

Заблокирован

25.04.2016, 10:28

4

Цитата
Сообщение от Gunjy
Посмотреть сообщение

Отлично работает рекурсия с функцией Dir(), … осуществляющий обход каталогов

Кодом не поделитесь?
Без костылей обход вложенных каталогов у меня не получается…



0



5 / 5 / 2

Регистрация: 12.03.2016

Сообщений: 10

25.04.2016, 13:55

5

Цитата
Сообщение от Shersh
Посмотреть сообщение

Кодом не поделитесь?
Без костылей обход вложенных каталогов у меня не получается…

Ну собственно с «костылями» видимо и у меня; насколько я помню собирал каталоги в строку, разделяя их «/», и передавал эту строку в эту же функцию.
(Точнее могу после работы посмотреть)



0



Gunjy

5 / 5 / 2

Регистрация: 12.03.2016

Сообщений: 10

25.04.2016, 23:55

6

Лучший ответ Сообщение было отмечено MIHAIL_WAS как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function Recursive_Dir(ByVal Path As String)
    Dim CurrentFile As String
    Dim Directories As String
    Directories = ""
    Dir Path & "*.*", vbDirectory 'skip "."
    Dir 'skip ".."
 
    Do
        CurrentFile = Dir()
        If CurrentFile <> "" And (GetAttr(Path & "" & CurrentFile) And vbDirectory) Then
            Debug.Print CurrentFile & " (Directory)"
            Directories = Directories & CurrentFile & "/"
        ElseIf CurrentFile <> "" Then
            Debug.Print CurrentFile
        End If
    Loop While CurrentFile <> ""
    
    While Directories <> ""
        Recursive_Dir Path & "" & Left(Directories, InStr(Directories, "/") - 1)
        Directories = Mid(Directories, InStr(Directories, "/") + 1)
    Wend
End Function

Вложения

Тип файла: xls 3.xls (32.5 Кб, 68 просмотров)



3



5561 / 1367 / 150

Регистрация: 08.02.2009

Сообщений: 4,107

Записей в блоге: 30

26.04.2016, 00:12

7

Есть готовый Excel-проект, но без рекурсивного углубления в подпапки. Пригодится?

Миниатюры

Поиск в папках и подпапках
 



0



Shersh

Заблокирован

26.04.2016, 09:10

8

Лучший ответ Сообщение было отмечено MIHAIL_WAS как решение

Решение

Пара уточнений, если позволите.

Цитата
Сообщение от Gunjy
Посмотреть сообщение

Visual Basic
1
2
Dir Path & "*.*", vbDirectory 'skip "."
Dir 'skip ".."

— если начнете с корневой («C:» к примеру) папки, то пропустите два ни в чем неповинных файла (или папки).

Цитата
Сообщение от Gunjy
Посмотреть сообщение

Dir Path & «*.*», vbDirectory ‘skip «.»

— будут пропущены все только_для_чтения, скрытые и(ли) системные файлы и папки.
Если они вдруг нужны, то стоит вместо vbDirectory записать vbReadOnly +vbHidden +vbSystem +vbDirectory

В итоге —

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function Recursive_Dir(ByVal Path As String)
    Dim CurrentFile As String
    Dim Directories As String
    CurrentFile = Dir(Path & "*.*", 63)
    While Len(CurrentFile)
        If CurrentFile <> "." And CurrentFile <> ".." Then
            If GetAttr(Path & "" & CurrentFile) And vbDirectory Then
                Debug.Print CurrentFile & " (Directory)"
                Directories = Directories & CurrentFile & "/"
            Else
                Debug.Print CurrentFile
            End If
        End If
        CurrentFile = Dir
    Wend
    
    While Directories <> ""
        Recursive_Dir Path & "" & Left(Directories, InStr(Directories, "/") - 1)
        Directories = Mid(Directories, InStr(Directories, "/") + 1)
    Wend
End Function

Примерно такие костыли я и делал в своё время, пока не остановился на 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

Цитата
Сообщение от Gunjy
Посмотреть сообщение

Отлично работает рекурсия с функцией Dir(), буквально пару часов назад открывал макрос, осуществляющий обход каталогов посредством этой функции. Есть ещё вот такая вещь для работы с файловой системой в VBA — FileSystemObject.

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
sub Вывод_адресов ()
 
Dim Res () As Variant
 
Res () = Func ("D:TEST")
 
For i = 1 to UBound (Res)                           '<
      Debug.Print Res (i)                              ' <=== Без цикла все работает, с циклом выдет ошибку
Next                                                        '<        Subscript out of range
 
End Sub
 
Function Func (path As String) As Variant ()
Dim CF As String
Dim Dirs As String
Dim result () As Variant
Dim n As Integer
n = 1
 
Dirs = ""
 
CF = Dir (path & "*.*", 63)
 
While Len (CF)
    If CF <> "." And CF <> ".." Then
        If GetAttr (path & "" & CF) And vbDirectory Then
            Dirs = Dirs & CF & "/"
        Else
            If (Right(CF, 3) = "doc" Or Right(CF, 4) = "docx") And Left(CF, 1) <> "~" Then
                Debug.Print CF
                ReDim Preserve result(1 To n)
                result(n) = path & "" & CF
                Debug.Print result(n)
                n = n + 1
            End If
 
        End If
    End If
    CF = Dir
Wend
 
While Dirs <> ""
    Func path & "" & Left(Dirs, InStr(Dirs, "/") - 1)
    Dirs = Mid(Dirs, InStr(Dirs, "/") + 1)
Wend
 
 
    
    Func= result
    Debug.Print "Результат назначен"
 
End Function



0



Поиск по файлам

scofield

Дата: Понедельник, 28.09.2015, 11:29 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

Добрый день! Подскажите пожалуйста, где я ошибаюсь. Задача следующаяя: имеются файлы, которые эксель определяет. В этих файлах хранится текстовая информация. В главном файле задается критерий для поиска и кноркой активируется поиск, после чего найденные записи по всем файлам выводятся на лист главного. Но при поиске он ищет почему-то только в самом себе, а не в нужных.

[vba]

Код

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

Next

On Error GoTo 0

Range(«a:e»).EntireColumn.AutoFit ‘ автоподбор ширины столбцов
End Sub

[/vba]

Заранее благодарен. Просьба не судить за русскоязычные переменные, знаю что это не правильно.
[moder]Оформите код тегами (кнопка #)[/moder]

К сообщению приложен файл:

6067555.xlsm
(31.5 Kb)

Сообщение отредактировал scofieldПонедельник, 28.09.2015, 11:34

 

Ответить

KSV

Дата: Понедельник, 28.09.2015, 11:58 |
Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 770


Репутация:

255

±

Замечаний:
0% ±


Excel 2013

Добрый день!
Открывайте так: [vba]

Код

Set WB = Workbooks.Open(Filename:=pathtothefile)

[/vba] а потом ищите так: [vba]

Код

Set РезультатПоиска = WB.ActiveSheet.Cells.Find(ТекстДляПоиска, LookAt:=xlPart)

[/vba]

К сообщению приложен файл:

8095689.xlsm
(29.6 Kb)


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

 

Ответить

scofield

Дата: Понедельник, 28.09.2015, 12:30 |
Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

Спасибо, все заработало!)
Помогите, пожалуйста с выводом данных
[vba]

Код

СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки)

[/vba]
Сюда записывается только Номер найденной строки, а если необхожимо что бы записывалось сама ячейка и ее адрес
И как потом вывод в цикле организовать
[vba]

Код

For j = 1 To СписокНомеровНайденныхСтрок.Count

                   НомерСтроки = СписокНомеровНайденныхСтрок.Item(j)

                        Range(«a» & Rows.Count).End(xlUp).Offset(1).Resize(, 6).Value = _
         Array(filenumber, Filename, pathtothefile, creationdate, filesize, НомерСтроки)

            ‘ если нужна гиперссылка на файл во втором столбце
         ActiveSheet.Hyperlinks.Add Range(«b» & Rows.Count).End(xlUp), pathtothefile, «», _
                    «Открыть файл» & vbNewLine & Filename
         Next

[/vba]

 

Ответить

KSV

Дата: Понедельник, 28.09.2015, 13:11 |
Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 770


Репутация:

255

±

Замечаний:
0% ±


Excel 2013

необхожимо что бы записывалось сама ячейка

не понял вопрос…
вам так надо? [vba]

Код

СписокАдресовНайденныхЯчеек.Add РезультатПоиска.Address(0, 0), РезультатПоиска.Address(0, 0) ‘ в формате A1
СписокАдресовНайденныхЯчеек.Add РезультатПоиска.Address(,,,1), РезультатПоиска.Address.Address(,,,1) ‘ в формате [имя файла книги]Лист1!$A$1

[/vba]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

 

Ответить

scofield

Дата: Понедельник, 28.09.2015, 13:15 |
Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

Ну надо, что бы в конце вывод выводилась информация о файле (filenumber, Filename, pathtothefile, creationdate, filesize)и тут же текст найденной ячейки и ее адрес (формат А1), наверно нужно доп массив заводить

Сообщение отредактировал scofieldПонедельник, 28.09.2015, 13:20

 

Ответить

KSV

Дата: Понедельник, 28.09.2015, 14:32 |
Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 770


Репутация:

255

±

Замечаний:
0% ±


Excel 2013

текст найденной ячейки и ее адрес

можно так [vba]

Код

СписокАдресовНайденныхЯчеек.Add РезультатПоиска.Value, РезультатПоиска.Address(0, 0)

[/vba]

что бы в конце вывод выводилась информация о файле

можно объявить на уровне модуля [vba]

Код

Dim coll As New Collection

[/vba]
и в GetAllFileNamesUsingFSO сохранять инфу о файле [vba]

Код

    For Each fil In curfold.Files    ‘ перебираем все файлы в папке FolderPath
         coll.Add Array(fil.Name, fil.Path, fil.DateCreated, fil.Size)
     Next

[/vba]
а потом ее можно выводить так [vba]

Код

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

                   ‘…

                   With Range(«a» & Rows.Count).End(xlUp).Offset(1)
             .Value = i                    ‘ номер файла
             .Offset(, 1).Resize(, 4).Value = coll(i)    ‘ инфа о файле
             With .Cells(, 2)
                 Filename = .Value
                 .Hyperlinks.Add .Cells(1), .Cells(, 2), , «Открыть файл» & vbNewLine & Filename, Filename
             End With
         End With
     Next

[/vba]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

 

Ответить

KSV

Дата: Понедельник, 28.09.2015, 15:39 |
Сообщение № 7

Группа: Друзья

Ранг: Ветеран

Сообщений: 770


Репутация:

255

±

Замечаний:
0% ±


Excel 2013

и я бы написал так: [vba]

Код

Dim colFileInfo As New Collection

Sub GetFilesInfo(ByVal DirPath As String, Optional ByVal FileMask As String = «*», _
                     Optional ByVal SearchDeep As Long = 999)
      ‘ Получает в качестве параметра путь к папке DirPath,
      ‘ маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
      ‘ и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
      ‘ Возвращает коллекцию, содержащую полные пути найденных файлов
      ‘ (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
      Dim FSO As Object
      Set FSO = CreateObject(«Scripting.FileSystemObject»)                ‘ создаём экземпляр FileSystemObject
      GetFilesInfoUsingFSO FSO.GetFolder(DirPath), FileMask, SearchDeep   ‘ поиск
      Set FSO = Nothing: Application.StatusBar = False                    ‘ очистка строки состояния Excel
End Sub

      Private Function GetFilesInfoUsingFSO(objFolder As Object, ByVal FileMask As String, ByVal SearchDeep As Long)
      ‘ перебирает все файлы и подпапки, используя объект FSO
      ‘ перебор папок осуществляется в том случае, если SearchDeep > 1
      ‘ добавляет пути найденных файлов в коллекцию colFileInfo

              ‘ раскомментируйте эту строку для вывода пути к просматриваемой
      ‘ в текущий момент папке в строку состояния Excel
      ‘Application.StatusBar = «Поиск в папке: » & objFolder.Path

              Dim objFile As Object
      For Each objFile In objFolder.Files ‘ перебираем все файлы в папке
          With objFile
              If .Name Like FileMask Then colFileInfo.Add Array(.Name, .Path, .DateCreated, .Size)
          End With
      Next

              SearchDeep = SearchDeep — 1                     ‘ уменьшаем глубину поиска в подпапках
      If SearchDeep Then                    ‘ если надо искать глубже
          For Each objFolder In objFolder.SubFolders  ‘ перебираем все подпапки в папке
              GetFilesInfoUsingFSO objFolder, FileMask, SearchDeep
          Next
      End If
End Function

[/vba]
[p.s.]для заполнения коллекции colFileInfo нужно вызвать процедуру GetFilesInfo [vba]

Код

Sub test()
      GetFilesInfo «C:UsersUserDownloadsDDE», «*.xls*» ‘ добавляем в коллекцию файлы *.xls, *.xlsb, *.xlsm, *.xlsx
End Sub

[/vba][/p.s.]


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Сообщение отредактировал KSVПонедельник, 28.09.2015, 15:41

 

Ответить

scofield

Дата: Понедельник, 28.09.2015, 16:04 |
Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

Спасибо большое за помощь, все заработало как надо

 

Ответить

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

ARM's user avatar

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

Our Man in Bananas's user avatar

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's user avatar

Baby Groot

4,62739 gold badges53 silver badges71 bronze badges

answered Jan 16, 2014 at 8:22

user3201590's user avatar

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!
vba save as

Learn More!

Like this post? Please share to your friends:
  • Vba excel поиск всех значений в столбце
  • Vba excel поиск всех значений в диапазоне
  • Vba excel поиск во всей книге
  • Vba excel поиск в цикле
  • Vba excel поиск в умной таблице