Страницы: 1
RSS
[VBA] Как открыть файлы и папки по маскам
 
Здравствуйте. Существуют ли простые способы открывать файлы и папки по маске названий? Кейс следующий - есть директории и файлы:
1. \ЛюбаяПапка\макрос.xlsm
2. \ЛюбаяПапка\YфайлY.xlsx
3. \ЛюбаяПапка\ПапкаY\Подпапка\подфайлY.xlsx

Сначала запускается файл с макросами из п.1, и в нем начинается работа с файлами. Мне нужно макросом открывать файлы из пунктов 2 и 3. Проблема в том, что названия папок и файлов могут меняться (переменное - всё, что обозначено как Y). Представляю я себе это примерно так (звездочки как маска):

Код
'открытие файла в п.2
PathFolderName = ThisWorkbook.Path ()
Workbooks.Open Filename:=ThisWorkbook.Path & "\*файл*.xlsx"


Код
'открытие файла в п.3
PathFolderName = ThisWorkbook.Path ()
Workbooks.Open Filename:=ThisWorkbook.Path & "\Папка*\Подпапка\подфайл*.xlsx"


Я нашел такое решение, но у меня оно не работает, либо я не смог корректно написать пути и названия:

Код
Sub Openfile()
  Dim Fso As Object, fs, Fl As Variant
    
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Application.ScreenUpdating = False
  For Each Fl In Fso.getfolder(ThisWorkbook.Path & "\").Files
    If Fl.Name Like "RSNOS_*Summary*" Then  'for rawdata file
      Workbooks.Open ThisWorkbook.Path & "\" & Fl.Name
    End If
  Next
End Sub
 
Fl уже содержит полный путь к файлу. Fl.Path вместо ThisWorkbook.Path & "\" & Fl.Name но все равно отлаживать надо ис мотреть что у вас там выходит в цикле.
По вопросам из тем форума, личку не читаю.
 
Dir может работать с масками файлов:
Код
FName = Dir(ThisWorkbook.Path & "\Папка\Подпапка\подфайл*.xlsx")
If FName <> "" then
    workbooks.open FName
end if

А вот с масками папок - нет, надо будет перебирать скорее всего.
Изменено: Дмитрий(The_Prist) Щербаков - 15.08.2022 19:25:15
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
andronus написал:
Я нашел такое решение, но у меня оно не работает,
сосредоточьтесь на том, что решение есть и не обращайте внимание на то, что оно не работает!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Дмитрий(The_Prist) Щербаков, Дим, по первому уровню может помочь https://www.script-coding.com/WSH/Shell.html#5.3.3. но дерево обходить все равно нужно.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
по первому уровню может помочь
да в общем-то Dir и в принципе к задаче можно применить. Что-то вроде(не сильно заморачивался упрощением - чисто пример):
Код
Sub get_file_by_mask()
    Dim s, sp$, FName$, fsp$, spath$, asp, lp&, lcnt&
    Dim arr
    
    sp = ThisWorkbook.Path & "\Папка*\Подпапка\подфайл*.xlsx"
    asp = Split(sp, "\")
    For lp = LBound(asp) To UBound(asp) - 1
        spath = s
        If Len(s) Then
            s = s & "\" & asp(lp)
        Else
            s = asp(lp)
        End If
        fsp = Dir(s, vbDirectory)
        If fsp <> "" Then
            lcnt = lcnt + 1
            If fsp <> asp(lp) And fsp <> "." Then
                s = spath & "\" & fsp
            End If
        End If
    Next
    If lcnt = UBound(asp) Then
        spath = s & "\"
    End If
    
    FName = Dir(spath)
    If FName <> "" Then
        Workbooks.Open spath & FName
    End If
End Sub

другой вопрос, что Dir не всегда корректно работает с длинными или сетевыми путями.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,
у меня вот этот
Код
Sub DirSub()
  Dim f$
  f = Dir("c:\t*.*", vbDirectory)
  Do While f <> ""
    Debug.Print f: f = Dir
  Loop
End Sub
написал в окне Immediate
Test
Tmp

ровно столько папок начинающихся на букву Т у меня в корне диска С
Изменено: Ігор Гончаренко - 15.08.2022 22:49:47
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
ровно столько папок
Согласен. Я лишь привел пример возможного решения задачи - а делать полноценное решение с учетом того, что может быть не одна папка и не один файл по заданной маске - удел самого ТС  ;)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
мой предыдущий пост о другом:
Цитата
Дмитрий(The_Prist) Щербаков написал:
Dir может работать с масками файлов
...
А вот с масками папок - нет
может, и по тем же правилам)
а автору темы нужно было описывать не сложности в его решении, а задачу, которую он решает
Изменено: Ігор Гончаренко - 15.08.2022 20:47:21
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Игорь, ну ведь и мы о другом. добавь /S и пройдет по подкаталогам, но это будет их перебор, хоть и не через VBA.
По вопросам из тем форума, личку не читаю.
 
Цитата
Ігор Гончаренко написал:
может, и по тем же правилам)
имелось ввиду, что не может одной строкой без прохода от корня к конечной папке и файлам:
Цитата
Дмитрий(The_Prist) Щербаков написал:
надо будет перебирать скорее всего
Изменено: Дмитрий(The_Prist) Щербаков - 15.08.2022 21:01:50
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
хорошо) значит мне показалось
в данной задаче понятно что нужно перебирать папки и файлы по маске, только не понятно по какой маске перебирать папки и по какой файлы
т.е. в теме
12 сообщений
0 решений
и вообще - к 12-у сообщению все еще не понятно какую задачу мы решаем, на самом деле не решаем ничего - трещим о разном (я - так точно)
вернусь к этому:
Цитата
andronus написал:
Я нашел такое решение
нашли? поздравляю! пользуйтесь
форум  не бюро находок, не нужно сюда нести никому не нужный код, который вы нашли
решаете задачу и не получается? обьясните что решаете, возможно, подскажут как это сделать
Цитата
БМВ написал:
ну ведь и мы о другом. добавь /S
понятно, я еще в 1985 году умел написать dir /? и прочитать все что может dir. все что не смог понять сразу - выяснял на конкретных примерах, пока не пойму)
вот и я о другом: когда кто-то внятно сформулирует вопрос - то получит на него ответ, а не тонны бесполезной переписки
Изменено: Ігор Гончаренко - 15.08.2022 22:51:45
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Dir может работать с масками файлов:
Благодарю. Сохранил.
Цитата
Дмитрий(The_Prist) Щербаков написал:
А вот с масками папок - нет, надо будет перебирать скорее всего.
Очень странно и очень жаль.
Цитата
Ігор Гончаренко написал:
а автору темы нужно было описывать не сложности в его решении, а задачу, которую он решает
Задачу я описал.

Всем спасибо. Раз маски названий папок нельзя просто так реализовать, придется задавать папкам неизменные названия, и уж от этого плясать.
 
Цитата
andronus написал:
Раз маски названий папок нельзя просто так реализовать,
Почему нельзя, вам же показали и варианты есть. Вплоть до вывода всех полных имен в массив и там уже поиск по маске.
Вот это вот  "\Папка*\Подпапка\подфайл*.xlsx" - это комбинация вхождения в строку "\Папка*\" и "\подфайл*.xlsx" а уж как это реализовать рекурсивным проходом по каталогам с  отсечкой ненужно, и тут можно и через dir , и FileSystemObject, и через Shell.Application ( я выше ссылку давал)  или, как написано игорем, через системный DIR ( вариант быстрый, но есть два момента - это мигание экрана и необходимость обработать кодовую страницу).
По вопросам из тем форума, личку не читаю.
 
Цитата
andronus: открывать файлы и папки по маске названий:
1. \ЛюбаяПапка\макрос.xlsm
2. \ЛюбаяПапка\YфайлY.xlsx
3. \ЛюбаяПапка\ПапкаY\Подпапка\подфайлY.xlsx
Да - просматриваете все пути, ВНУТРИ папки (так или через командную строку) "…\ЛюбаяПапка\…" — которые подходят по маске, собираете в массив или открываете сразу. Если сразу не открывали, то постом делаете с массивом нужных путей, что угодно
Изменено: Jack Famous - 16.08.2022 11:55:36
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
господа перестаньте насыпать советы, дайте одно готовое решение)
Цитата
andronus написал:
Задачу я описал
вы описали а ни одного решения нет не потому что задача хрен знает какая сложная, а потому что тут нет задачи. есть намеки на наличие задачи, а описания задачи - нет!
Цитата
andronus написал:
Раз маски названий папок нельзя просто так реализовать
маски папок реализуются не сложнее, чем маски файлов (если речь действительно о масках)
а что вам лично трудно реализовать никто не понимает, потому что не понимает что нужно получить в итоге. понимаете? невозможно написать макрос, если не ясно что должно быть итогом работы этого макроса
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
вы описали а ни одного решения нет не потому что задача хрен знает какая сложная, а потому что тут нет задачи. есть намеки на наличие задачи, а описания задачи - нет!
Я не собираюсь спорить. Кто ответил по теме, те прочитали первый пост, где в первых двух абзацах описана задача - открывать файлы и папки по маскам.
Цитата
Дмитрий(The_Prist) Щербаков написал:
Dir может работать с масками файлов:Код ? 1234FName = Dir(ThisWorkbook.Path & "\Папка\Подпапка\подфайл*.xlsx")If FName <> "" then    workbooks.open FNameend ifА вот с масками папок - нет, надо будет перебирать скорее всего.
Не работает. Вернее, странно как-то работает - находит верный файл, но рапортует о его несуществовании. Макрос запускается из файла, расположенного в папке "тест", то есть, путь до искомого файла выглядит так: ThisWorkbook\Папка\Подпапка\.
Путь прописан верно, файл находится с верным называнием, но не открывается.
Изменено: andronus - 16.08.2022 14:04:18
 
Замените строку - workbooks.open FName

На строку - workbooks.open ThisWorkbook.Path & "\Папка\Подпапка\" & FName

Т.е. надо добавить путь к найденному файлу
 
на конкретный вопрос можно дать конкретный ответ. скопируйте этот
Код
Sub OpenOneFile()
  Dim f$, pt$
  pt = ThisWorkbook.Path & "\Папка\Подпапка\"
  FName = Dir(pt & "\подфайл*.xlsx")
  If FName <> "" Then Workbooks.Open pt & FName
End Sub

в ваш файл, выполните. получилось? (открылся файл заданный маской а не точным именем)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
andronus написал:
Я не собираюсь спорить
и это правильно. зачем спорить. пользуйтесь решениями, что вам выложили) ваша задача открыть 1 файл? - открывайте))
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Игорь, заканчивай упражнение.  :D
По вопросам из тем форума, личку не читаю.
 
Александр Макаров, не работает, ругается на амперсанд. Но спасибо за помощь.
Ігор Гончаренко, спасибо, работает.
 
Цитата
andronus: ругается на амперсанд
это невозможно, в данном случае
Ругается на строку ThisWorkbook.Path & "\Папка\Подпапка" & FName, поскольку такого пути у вас не существует и маски там тоже нет.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх