Макрос - Открытие найденого файла по части имени

[LLIaMaH]

Помогите чайнику. Пытаюсь написать макрос поиска файла в определенной папке (и под каталогах) по части имени и последующего его открытия. Пытаюсь написать так:

ChDir "D:\Forma_1"
Set fs = Application.FileSearch
fs.NewSearch
fs.LookIn = "D:\Forma_1"
fs.SearchSubFolders = True
fs.Filename = "1 форма ** 10.xls" ** - могут быть 08 или 09 и тд.
fs.Execute
If fs.Execute() > 0 Then (КАК ЗДЕСЬ ПРОПИСАТЬ ОТКРЫТИЕ НАЙДЕНОГО ФАЙЛА) Else MsgBox "Файл `1 форма` не найден"

End Sub
Или подскажите как по другому это можно сделать.

[EducatedFool]

Application.FileSearch лучше не использовать - он не работает в Excel 2007

Попробуйте так:

Sub test()
    папка = "D:\Forma_1\"
    файл = Dir(папка & "1 форма ?? 10.xls")
    If Len(файл) = 0 Then MsgBox "Файл `1 форма` не найден", vbCritical: Exit Sub   ' нет подходящего файла
    
    Dim wb As Workbook: Set wb = Workbooks.Open(папка & файл) ' открываем найденный файл
    wb.Worksheets(1).[d5] = "текст"    ' пишем текст в ячейку d5
    wb.Close True    ' закрываем файл с сохранением изменений
End Sub

PS: подкаталоги просматриваться не будут.

[EducatedFool]

Чтобы искать и в подпапках тоже, используйте эту функцию: http://excelvba.ru/code/FilenamesCollection

Код будет выглядеть так:

Sub test()
    Dim coll As Collection, ПутьКПапке As String
    ПутьКПапке = "D:\Forma_1\"
    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, "1 форма ?? 10.xls")
    If coll.Count = 0 Then MsgBox "Файл `1 форма` не найден", vbCritical: Exit Sub    ' нет подходящего файла
    If coll.Count > 1 Then MsgBox "Найдено НЕСКОЛЬКО файлов `1 форма`", vbExclamation: Exit Sub   ' Найдено НЕСКОЛЬКО файлов

    Dim wb As Workbook: Set wb = Workbooks.Open(coll(1))    ' открываем найденный файл
    wb.Worksheets(1).[d5] = "текст"    ' пишем текст в ячейку d5
    wb.Close True    ' закрываем файл с сохранением изменений
End Sub

Пример в файле: http://excelvba.ru/XL_Files/Sample__...__17-40-48.zip

[LLIaMaH]

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

И еще, возможно ли прописать так, чтобы при появлении ЛЮБОГО MsgBox автоматом нажималось "Ок", или "Cancel" или просто "Escape"??

[EducatedFool]

В начало макроса ставите запрет вывода лишних вопросов и предупреждений:

Sub ВашМакрос()
    On Error Resume Next    ' чтобы до последней строки выполнение в любом случае дошло
    Application.DisplayAlerts = False    ' отключаем вывод предупреждений

    ' ваш код здесь

    Application.DisplayAlerts = True    ' не забываем включить обратно в конце макроса
End Sub

[LLIaMaH]

Спасибо))))

[sova1303]

Сообщение от EducatedFool

Application.FileSearch лучше не использовать - он не работает в Excel 2007

Попробуйте так:

Sub test()
    папка = "D:\Forma_1\"
    файл = Dir(папка & "1 форма ?? 10.xls")
    If Len(файл) = 0 Then MsgBox "Файл `1 форма` не найден", vbCritical: Exit Sub   ' нет подходящего файла
    
    Dim wb As Workbook: Set wb = Workbooks.Open(папка & файл) ' открываем найденный файл
    wb.Worksheets(1).[d5] = "текст"    ' пишем текст в ячейку d5
    wb.Close True    ' закрываем файл с сохранением изменений
End Sub

PS: подкаталоги просматриваться не будут.

Уважаемый модератор,
В Вашем ответе 24.09.2010, 14:16 LLIaMaH'у следующая строка
файл = Dir(папка & "1 форма ?? 10.xls")
выглядит вроде правильно и мне понятно, что должно работать, но... у меня (Access 2007), VBA, модуль - не работает.
Попробую объяснить.
У меня "идея фикс" написать открытие файла ("по уникальной части имени") просто, без большого кода, дополнительных переменных и именно с помощью DIR(). Далее - я не хочу связываться ни с какими диалогами открытия такого файла или с хранением папки, части имени файла, расширением и т.п. в таблице.
У меня функция Dir() выглядит примерно так:
файл = Dir(CurrentProject.Path & Me![поле1].Value & Me![поле2].Value & Me![поле3].Value & "*.bmp")
Access говорит, что не может открыть файл
x:\папка проекта\BMP\ПравильнаяЧастьИмени*.b mp
т.е. в сообщении access'а четко написана *
И, хотя, как видите, у меня написано вроде бы так же, как в Вашем примере -
Подскажите, пожалуйста, как сделать эту * не звездочкой, а маской.

[IgorGO]

если "ПравильнаяЧастьИмени"
является не Правильной Частью Имени
то именно такое сообщение Вы и получите

модератор тут не при чем присмотритесь к тому, что Вы пишете

[Казанский]

Сообщение от sova1303

У меня функция Dir() выглядит примерно так...
... у меня написано вроде бы так же

Выражайтесь конкретнее, приведите кусок кода - что дальше происходит с переменной файл?
Сама функция Dir не может вызвать сообщение об ошибке открытия файла, т.к. не открывает файл.
И проверьте, не в песочнице ли Вы

Сообщение от https://support.office.com/en-us/article/Dir-Function-1a1a4275-f92f-4ae4-8b87-41e4513bba2e

Dir Function
NOTE The function, method, object, or property described in this topic is disabled if the Microsoft Jet Expression Service is running in sandbox mode, which prevents the evaluation of potentially unsafe expressions. For more information on sandbox mode, search for "sandbox mode" in Help.

[sova1303]

Сообщение от IgorGO

если "ПравильнаяЧастьИмени"
является не Правильной Частью Имени
то именно такое сообщение Вы и получите

модератор тут не при чем присмотритесь к тому, что Вы пишете

Уважаемый IgorGO, я и в мыслях не имел ни на кого (тем более - на уважаемого модератора) наезжать. Это было просто обращение.
ПравильнаяЧастьИмени - правильна и проверена в окне значений. Я, пардон, о другом и, по-моему, очень конкретно - я о звездочке. которую нужно написать как-то иначе - вот о чем вопрос.
Кусок кода, конечно. могу выложить и сделаю это, но нельзя ли получить хоть какой-то ответ по поводу звездочки?..