Поиск файла в папке vba excel

 

lenok

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

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

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

 

Johny

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

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

А файл какой? Excel?

There is no knowledge that is not power

 

lenok

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

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

да. в 2003 экселе пытаюсь написать

 

Johny

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

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

#4

23.05.2013 11:40:58

Код
Sub f()

    Dim f As String, folder As String, file_name As String

    'Папка для поиска
    folder = "C:Temp"
    
    'Ячейка с именем файла
    file_name = Range("A1")
    
    f = Dir(folder)
    While Not Len(f) = 0
        If f = file_name Then
            Workbooks.Open folder & f
        End If
        f = Dir()
    Wend

End Sub

There is no knowledge that is not power

 

lenok

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

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

 

lenok

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

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

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

 

Johny

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

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

#7

24.05.2013 14:28:11

Код
Application.DisplayAlerts = False
.....
.....
.....
Application.DisplayAlerts = True

Изменено: Johny24.05.2013 14:28:36

There is no knowledge that is not power

 

lenok

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

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

а можно ли сделать, чтобы он искал документ в поддиректориях??? :oops:

 

Johny

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

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

#9

31.05.2013 17:18:58

Ставим галку: Tools -> References -> Microsoft Scripting Runtime

Код
Private file_name As String
Private f As File, fld As folder

Sub SearchAndOpen()

    Dim source_folder As String
    Dim fso As New FileSystemObject

    'Папка для поиска
    source_folder = "C:TempDir"
    
    'Ячейка с именем файла
    file_name = Range("A1")
    
    Call EnumerateFiles(fso.GetFolder(source_folder))

End Sub

Private Sub EnumerateFiles(root_folder As folder)

    For Each f In root_folder.Files
        If f.Name = file_name Then
            Workbooks.Open f.Path
        End If
    Next
    
    For Each fld In root_folder.SubFolders
        Call EnumerateFiles(fld)
    Next
    
End Sub

Изменено: Johny31.05.2013 17:19:49

There is no knowledge that is not power

 

Hugo

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

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

#10

31.05.2013 17:29:09

Я чего-то не понимаю?
Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали.
А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк:

Код
Sub f()
    On Error GoTo err_: Workbooks.Open "C:Temp" & Range("A1"): Exit Sub
err_:     MsgBox "Нет такого файла!"
End Sub
 

Юрий М

Модератор

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

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

Я тоже не понимаю смысла в поиске…

 

KuklP

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

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

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

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

 

lenok

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

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

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

:oops:

 

Hugo

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

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

Если например ситуации такие:
— есть точный список названий файлов
— в определённом месте (папки/подпапки) регулярно генерятся файлы (известна часть имени, или даже не известна)
— нужно открыть все файлы определённой папки/подпапки
— есть какая-то другая система в этих файлах
и открывать такие файлы предстоит регулярно — то есть смысл один раз и надолго облегчить себе работу макросом.
Если же никакой системы нет — то и макросом открывать файлы нет смысла.
Другое дело, что если обработка этих открываемых файлов предстоит макросом — то можно в этот же макрос вписать диалог выбора этих файлов. Т.е. запустили макрос, в диалоге указали сразу все нужные файлы, получили готовый результат.

 

lenok

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

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

Есть огромный отчет. после обработки макросом, надо, чтобы он брал имя файла из определенной ячейки и открывал фаил с таким именем. информации много, и такой отчет обрабатывается каждый месяц. примерное кол-во файлов на один отчет больше 1000, поэтому, сами понимаете, что открывать каждый, это рутина. таких отчетов за один месяц 30 штук. соответственно, около 30000 существующих файлов…вот как-то так все глобально……

просто открыть, с этим мы разобрались….. но некоторые файлы находятся в поддиректориях, и постоянно происходят какие-то перемещения в этой директории…

 

Hugo

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

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

#16

03.06.2013 11:32:43

В теме

http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=25457

есть файл

http://www.planetaexcel.ru/bitrix/components/bitrix/forum.interface/show_file.php?fid=40202&action=download

Там есть такой код:

Код
    For Each aFolder In fso.GetFolder(ThisWorkbook.Path).Files
    
        For Each aFile In aFolder.Files
        
            If fso.GetExtensionName(aFile.Name) Like "xls*" Then
            
                Set wkb = Workbooks.Open(aFile.Path)
                Set wks = wkb.Worksheets(1)
                With wks

и т.д.
Думаю, можно использовать.

 

lenok

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

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

что-то я не могу разобраться совсем :cry:

 

anvg

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

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

Excel 2016, 365

Пробуйте, первый запуск будет долгим. Далее быстрее. Если есть подозрение, что файлы в папке и подпапках изменили положение или имя, то нажать «Обновить». Путь к начальной папке задаётся константой baseFolder в методе InitializeFindю
Успехов.

 

lenok

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

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

#19

04.06.2013 07:29:04

Код
    Const baseFolder = "d:project"

я так понимаю, здесь надо прописать адрес самой папки, это понятно…
а имя файла он где будет брать???

 

anvg

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

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

Excel 2016, 365

#20

04.06.2013 07:50:49

Цитата
а имя файла он где будет брать???

Из активной ячейки (в ней только имя, без расширения)

Изменено: anvg04.06.2013 07:52:42

 

lenok

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

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

#21

04.06.2013 08:07:46

все, поняла….. все работает…спасибо большое….   :D  и еще один вопрос, если можно….:
как это все сделать так, чтобы он был без этих кнопочек, а в таком виде, чтобы автоматически включался???

до этого было прописано так, но он только с одной папки так открывает….
Заранее огромное спасибо вам!!!!!!!!   :oops:  

Код
Sub ARM()
    Dim f As String, folder As String, file_name As String
    'Папка для поиска
    folder = "C:Documents and SettingsmaksРабочий столДокументы"
    'Ячейка с именем файла
    file_name = LCase(Range("D1")) & ".xls"
    f = Dir(folder)
    While Not Len(f) = 0
        If LCase(f) = file_name Then

            Workbooks.Open folder & f
           
 Application.Run "ARM.XLS!ARM6"
            Exit Sub
        End If
        f = Dir()
    Wend

    Application.Run "ARM.XLS!ARM4"
End Sub

Изменено: lenok04.06.2013 23:58:03

 

KuklP

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

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

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

#22

04.06.2013 08:24:36

А на кой тут цикл? Если имя файла известно, зачем перебирать все файлы?

Код
Sub ARM()
    Dim folder As String, file_name As String
    'Папка для поиска
    folder = "C:Documents and SettingsmaksРабочий столДокументы"
    'Ячейка с именем файла
    file_name = LCase(Range("D1")) & ".xls"
    If Len(Dir(folder & file_name)) Then
        Workbooks.Open folder & file_name
        Application.Run "ARM.XLS!ARM6"
        Exit Sub
    End If
    Application.Run "ARM.XLS!ARM4"
End Sub

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

 

lenok

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

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

он не открывает тогда файл в поддиректории :(

 

KuklP

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

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

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

Ага. А с циклом, следовательно, открывает?

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

 

lenok

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

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

неа…  тоже не открывает….   :| а надо, чтобы открывал… там мне уже без разницы, есть цикл или нет… надо, чтобы он поддиректории просматривал :?:

 

anvg

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

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

Excel 2016, 365

#26

04.06.2013 09:43:56

:?:

Скрытый текст

 

lenok

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

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

 

Sandero

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

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

#28

18.06.2019 13:20:28

Цитата
Hugo написал:
Я чего-то не понимаю?Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали.А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк

Добрый день!
Попробовал ваш вариант, работает. Я правда добавил ещё запуск другого макроса по созданию файла с этим именем если его нет (т.е. если не выполнено первое условие)
Эксель при отсутствии файла выдаёт своё собственное сообщение
По нажатии «оК» появляется уже месседж из макроса.
М.б. это связано с версией экселя, у меня 2016, а тут код вроде для 2003 изначально, или это не имеет значения.
Можно ли убрать сообщение самого экселя?
Заранее благодарен!!

Код
Sub SearhFiles() 'Макрос поиска файла с именем и автоматическое его открытие при наличии
On Error GoTo err_: Workbooks.Open "\Server777S" & Range("F2") & ".xls": Exit Sub
err_:     MsgBox "Нет такого файла!"
Application.Run "DOC.xlsm!Upload" 'Запуск макроса по созданию файла с именем
End Sub

Макрос 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
  • 301904 просмотра

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

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

Студворк — интернет-сервис помощи студентам

В папке с:отчеты лежат отчёты по дням:
«отчёт за 16.05.2017».xls
«отчёт за 15.05.2017».xls
«отчёт за 14.05.2017».xls
И т.д.

Пишу макрос, который будет искать по маске: «отчёт за » & Date — x».xls» , за какую дату был записан последний отчёт, то есть ‘x’. Перерыв в формировании отчёта может достигать 5 дней.
Что мешает: не могу понять, как выйти из двух циклов после первого вхождения.
У меня получается так, или не останавливается, цикл X и выдаёт последнее, а не первое совпадение, или наоборот не найдя х=1 не переходит к x=2.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub
fail = Dir ("с:отчетыотчёт за *.xls")
Do while fail <> " "
Cells (r, 1) = fail
r = r + 1
fail = Dir
Loop
for x=1 to 5 
f1 = "отчёт за " & Date - x & ".xls"
For r = 1 To WorksheetFunction.CountA(Range("A:A"))
If f1 = Cells(r, 1) Exit For
End If
Next r
Exit For
Next x
MsgBox (x)
End Sub

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

Поиск файлов в папке и её подпапках

Alex_ST

Дата: Пятница, 22.06.2012, 15:31 |
Сообщение № 1

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Выводится список файлов, найденных в заданной папке.
Можно задавать глубину «погружения» в подпапки и маску имён файлов
В ячейки столбцов для каждого из найденных файлов выводятся:
— имя файла — гиперссылка на файл
— полный или сокращённый (от заданной папки) путь к файлу
— дата и время создания файла
— размер файла
— дата и время модификации файла
Прицеплен «Удобный автофильтр», позволяющий легко фильтровать полученные данные.



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STПятница, 22.06.2012, 20:45

 

Ответить

Alex_ST

Дата: Пятница, 22.06.2012, 21:59 |
Сообщение № 2

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

К стати, кто подскажет, где я нахомутал (просто, наверное, глаз замылился)?
Заметил при тестировании два мелких косяка:
1. Значение чек-бокса SheetFind.CheckBox_ShortPath при открытии файла сохраняется таким, каким оно было при сохранении перед закрытием. А вот переменная ShortPath, которую я пытаюсь по нему выставить в процедурах обработки событий Workbook_Open, Worksheet_Activate, Worksheet_Activate ставиться не хочет. Поэтому перед первым поиском приходится чекнуть бокс туда-обратно чтобы результат ему соответствовал.
2. В процедуре [vba]

Code

Sub ОчисткаСписка()
     On Error Resume Next
     If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData   ‘ сбросить фильтры
     Intersect(Rows(«6:» & Rows.Count), ActiveSheet.UsedRange).ClearContents   ‘ удалить содержимое
     Intersect(Rows(«7:» & Rows.Count), ActiveSheet.UsedRange).Rows.Delete Shift:=xlUp   ‘ сократить UsedRange
     ActiveSheet.Cells(1, 1).End(xlDown).Offset(1).Select   ‘  сдвинуть экран к последней заполненной ячейке
End Sub

[/vba]после удаления строк UsedRange чистится не сразу (видно по размеру «бегунка» прокрутки строк), а только по второму нажатию.



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STПятница, 22.06.2012, 22:01

 

Ответить

Alex_ST

Дата: Среда, 27.06.2012, 13:41 |
Сообщение № 3

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Полирнул код и «продвинул» (расширил и углУбил) интерфейс:
— добавлен лист с избранными путями поиска и возможность выбора пути из их списка
— пути поиска при их добавлении по кнопке «Добавить в Избранные» унифицируются и сортируются автоматически.
— для ускорения процедуры и удобства работы с результатами (чтобы при выделении случайно не кликнуть на ссылку) гиперссылки теперь не ставятся по умолчанию, а есть кнопка для из установки/удаления
— по даблклику по имени файла теперь можно открыть файл, по полному пути — открыть папку
— кнопки теперь «интерактивные»
— и что-то ещё (не помню)

Прошу прощения. Обнаружил ошибку cry
Файл отсюда удаляю. Исправленный файл — в следующем посте.



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STЧетверг, 28.06.2012, 12:11

 

Ответить

Alex_ST

Дата: Четверг, 28.06.2012, 12:15 |
Сообщение № 4

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Ещё раз прошу прощения за допущенную в предыдущем посте ошибку в процедуре.
Кроме того, наткнулся на недокументированное ограничение Excel: гиперссылок на листе может быть не более 65530 штук.
Просканировал у себя Programm Files и при попытке расставить гиперссылки вылетел в отладку sad
Ошибку исправил. Ограничение учёл.



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

adaebella

Дата: Пятница, 26.10.2012, 22:49 |
Сообщение № 5

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

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

Сообщений: 1


Репутация:

0

±

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


здраствуйте Alex ST . мне очень нужна ваша помощь в екселе . пожалоста ответь мне или здесь или прямо в скайп : ruslan4963 . зарание спасибо и буду ждать своево ответа. с уважениям Русан

 

Ответить

KuklP

Дата: Пятница, 26.10.2012, 23:52 |
Сообщение № 6

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369


Репутация:

486

±

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


2003-2010

adaebella, для таких сообщений есть кнопка «Приват».


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

 

Ответить

Alex_ST

Дата: Понедельник, 29.10.2012, 09:42 |
Сообщение № 7

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Quote (adaebella)

буду ждать своево ответа

Ждите ответа, ждите ответа, ждите ответа, ждите ответа, ждите ответа… biggrin

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



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STПонедельник, 29.10.2012, 09:44

 

Ответить

RAN

Дата: Понедельник, 29.10.2012, 21:11 |
Сообщение № 8

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

Ранг: Экселист

Сообщений: 5645

Quote (Alex_ST)

гиперссылок на листе может быть не более 65530 штук

Леш, это от версии не зависит? Или это ограничение твоего любимого?


Быть или не быть, вот в чем загвоздка!

 

Ответить

Alex_ST

Дата: Понедельник, 29.10.2012, 21:21 |
Сообщение № 9

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Привет, Андрей!
Вот в упор не помню. Разбирался с этим в июне и всё уже выветрилось из головы.
На 2003-ем точно. На 2007/2010, кажется, тоже. Но не на 100% уверен.
Но ведь проверить-то просто: убери в коде ограничение на количество гиперссылок и просканируй без ограничения глубины что-нибудь монструозное, ну, например C:Windows biggrin



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

KuklP

Дата: Понедельник, 29.10.2012, 21:22 |
Сообщение № 10

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369


Репутация:

486

±

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


2003-2010

65536. И это еще не все свинство мелкомягких. Не знаю, как с гиперссылками, а формулы листа в макросах не могут обрабатывать массивы большего размера. В том числе и в новых версиях. При миллионе строк на листе, это, мягко говоря, жалко выглядит.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

 

Ответить

Alex_ST

Дата: Понедельник, 29.10.2012, 21:24 |
Сообщение № 11

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

или всё-таки 65535 ? biggrin



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

KuklP

Дата: Понедельник, 29.10.2012, 21:27 |
Сообщение № 12

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369


Репутация:

486

±

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


2003-2010

А кто мешает тебе открыть свой(наш) любимый и нажать ctrl+down? tongue


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

 

Ответить

RAN

Дата: Понедельник, 29.10.2012, 22:19 |
Сообщение № 13

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

Ранг: Экселист

Сообщений: 5645

Quote (Alex_ST)

просканируй без ограничения глубины что-нибудь монструозное, ну, например C:Windows

ГЫ! У меня даже там всего половина!


Быть или не быть, вот в чем загвоздка!

 

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 09:04 |
Сообщение № 14

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Серёга, а ты про что без пояснения написал
Я вообще-то говорил про количество гиперссылок на листе. Так их ТОЧНО 65530
Я это проверял в пошаговом режиме (естественно, не нажимая 65000 раз F8, а тормознув программу Stop’ом на 65520 biggrin — лень было делать Exit For по ошибке )

А строк на листе нашего любимого 2003-го, действительно 65536.

А в ящике пива 24 бутылки, а в сутках 24 часа. Совпадение? biggrin



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STВторник, 30.10.2012, 09:05

 

Ответить

KuklP

Дата: Вторник, 30.10.2012, 09:10 |
Сообщение № 15

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369


Репутация:

486

±

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


2003-2010

Леш, это делается без stop. add watch — i=65530 — ставим радиоточку на break if true. Потом этот watch можно редактировать прямо в окне watches:-)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

 

Ответить

Alex_ST

Дата: Вторник, 30.10.2012, 09:11 |
Сообщение № 16

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Серёга, хорош флудить.



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

KuklP

Дата: Вторник, 30.10.2012, 09:12 |
Сообщение № 17

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369


Репутация:

486

±

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


2003-2010

А где флуд? Все по теме.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

 

Ответить

Alex_ST

Дата: Вторник, 04.12.2012, 13:39 |
Сообщение № 18

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Подправил файл (там, оказывается, поломалась расстановка гиперссылок)



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STВторник, 04.12.2012, 13:40

 

Ответить

Алексей

Дата: Пятница, 21.06.2013, 20:04 |
Сообщение № 19

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

 

Ответить

Alex_ST

Дата: Пятница, 21.06.2013, 21:17 |
Сообщение № 20

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

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

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


2003

Дорабатывать надо… И самое главное — придумать как именно удобно

Цитата (Алексей)

особым образом помечать файлы

Но мне это не нужно, а времени свободного сейчас нет…
Так что извините, но я сейчас с этим ковыряться просто не могу.



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

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