lenok Пользователь Сообщений: 39 |
Помогите, пожалуйста. |
Johny Пользователь Сообщений: 2737 |
А файл какой? Excel? There is no knowledge that is not power |
lenok Пользователь Сообщений: 39 |
да. в 2003 экселе пытаюсь написать |
Johny Пользователь Сообщений: 2737 |
#4 23.05.2013 11:40:58
There is no knowledge that is not power |
||
lenok Пользователь Сообщений: 39 |
|
lenok Пользователь Сообщений: 39 |
а как сделать, чтобы выбор варианта ответа при появлении диалогового окна был автоматический, или чтобы оно вообще не вылазило??? |
Johny Пользователь Сообщений: 2737 |
#7 24.05.2013 14:28:11
Изменено: Johny — 24.05.2013 14:28:36 There is no knowledge that is not power |
||
lenok Пользователь Сообщений: 39 |
а можно ли сделать, чтобы он искал документ в поддиректориях??? |
Johny Пользователь Сообщений: 2737 |
#9 31.05.2013 17:18:58 Ставим галку: Tools -> References -> Microsoft Scripting Runtime
Изменено: Johny — 31.05.2013 17:19:49 There is no knowledge that is not power |
||
Hugo Пользователь Сообщений: 23255 |
#10 31.05.2013 17:29:09 Я чего-то не понимаю?
|
||
Юрий М Модератор Сообщений: 60586 Контакты см. в профиле |
Я тоже не понимаю смысла в поиске… |
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
Я сам — дурнее всякого примера! … |
lenok Пользователь Сообщений: 39 |
Просто документов очень много. и постоянно открывать файлы под определенными названиями….. смысл тогда составления макроса… Пишу для автоматизации процессов обработки информации, и остановилась на этом моменте.
|
Hugo Пользователь Сообщений: 23255 |
Если например ситуации такие: |
lenok Пользователь Сообщений: 39 |
Есть огромный отчет. после обработки макросом, надо, чтобы он брал имя файла из определенной ячейки и открывал фаил с таким именем. информации много, и такой отчет обрабатывается каждый месяц. примерное кол-во файлов на один отчет больше 1000, поэтому, сами понимаете, что открывать каждый, это рутина. таких отчетов за один месяц 30 штук. соответственно, около 30000 существующих файлов…вот как-то так все глобально…… просто открыть, с этим мы разобрались….. но некоторые файлы находятся в поддиректориях, и постоянно происходят какие-то перемещения в этой директории… |
Hugo Пользователь Сообщений: 23255 |
#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 Там есть такой код:
и т.д. |
||
lenok Пользователь Сообщений: 39 |
что-то я не могу разобраться совсем |
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
Пробуйте, первый запуск будет долгим. Далее быстрее. Если есть подозрение, что файлы в папке и подпапках изменили положение или имя, то нажать «Обновить». Путь к начальной папке задаётся константой baseFolder в методе InitializeFindю |
lenok Пользователь Сообщений: 39 |
#19 04.06.2013 07:29:04
я так понимаю, здесь надо прописать адрес самой папки, это понятно… |
||
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
#20 04.06.2013 07:50:49
Из активной ячейки (в ней только имя, без расширения) Изменено: anvg — 04.06.2013 07:52:42 |
||
lenok Пользователь Сообщений: 39 |
#21 04.06.2013 08:07:46 все, поняла….. все работает…спасибо большое…. и еще один вопрос, если можно….: до этого было прописано так, но он только с одной папки так открывает….
Изменено: lenok — 04.06.2013 23:58:03 |
||
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
#22 04.06.2013 08:24:36 А на кой тут цикл? Если имя файла известно, зачем перебирать все файлы?
Я сам — дурнее всякого примера! … |
||
lenok Пользователь Сообщений: 39 |
он не открывает тогда файл в поддиректории |
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
Ага. А с циклом, следовательно, открывает? Я сам — дурнее всякого примера! … |
lenok Пользователь Сообщений: 39 |
неа… тоже не открывает…. а надо, чтобы открывал… там мне уже без разницы, есть цикл или нет… надо, чтобы он поддиректории просматривал |
anvg Пользователь Сообщений: 11878 Excel 2016, 365 |
#26 04.06.2013 09:43:56
|
|
lenok Пользователь Сообщений: 39 |
|
Sandero Пользователь Сообщений: 14 |
#28 18.06.2019 13:20:28
Добрый день!
|
||||
Функция 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 | ||
|
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
Поиск файлов в папке и её подпапках |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |