Как открыть файл, опираясь только на его расширение?

[Completum]

Здравствуйте, уважаемые пользователи форума! Вы мне во многом помогали! Желаю всем счастья и низкий вам поклон! Раньше я получил ответ на вопрос как сделать так, чтобы программа открывала файл в том же месте, где находится текущий открытый файл Excel, в котором ведётся работа. Ответ получил:

Код: (vb)

Workbooks.Open Filename:=ThisWorkbook.Path & "\MindMap (Excel).xml"

Теперь появилась потребность открывать тот же файл, независимо от его названия (MindMap (Excel).xml или MM (Ex) (проба).xml и т.д.), опираясь только на расширение .xml, с помощью макроса в текущем открытом файле Excel. Он находится в той же папке, что и вспомогательный файл, который нужно периодически открывать, и является единственным на ноутбуке с таким расширением. Возможно ли это?

Благодарю всех, прочитавших тему!

[Дмитрий Щербаков(The_Prist)]

Вам сюда: Просмотреть все файлы в папке
Т.к. нельзя просто по маске открыть один файл - придется открывать все в папке. Чтобы адаптировать код под себя, не выбирая папку каждый раз - можно вместо этого блока:

Код: (vb)

With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With

записать только одну строку:

Код: (vb)

sFolder = ThisWorkbook.Path

все, код готов. Файлы получили, дальше делайте с ними что надо.

[Completum]

Благодарю за ответ, The_Prist!

Ещё до конца не разбирался, но смысл как бы понятен (надо вникать в код). Интуитивно предполагаю, что если поместить эти 2 файла: с которым работаю (который с макросом и уже открыт) и вспомогательный (который надо открывать) в одну папку, что-то упростится. Это так? Т.е. в этой папке будет всего 2 файла.

[Completum]

Извините, всё понятно стало! 

[Юрий М]

Если в папке ВСЕГО два файла, то перебираем их циклом и проверяем имя: если имя файла не равно имени файла с макросом, то этот файл и открываем.

[Completum]

Спасибо большое!

[Completum]

Не могу немного разобраться. У меня есть один макрос (где-то в интернете его нашёл, сам я очень поверхностный деятель в этом направлении):

Код: (vb)

Sub Новая_карта()
Dim f As String
Dim e As Worksheet
For Each e In Worksheets
 If e.Name = "FreeMind Sheet" Then
  Application.DisplayAlerts = False
  Sheets("FreeMind Sheet").Delete 'удаление листа
  Application.DisplayAlerts = True
 End If
Next e
Filename = "MindMap (Excel).xml"
'f - название текущей (целевой) книги (в данном случае - "Телемаркетинг.xlsm")
f = ActiveWorkbook.Name
'Открываем ф-л, из которого надо копировать (вспомогательный ф-л)
Workbooks.Open Filename:=ThisWorkbook.Path & "\MindMap (Excel).xml"
'Копируем лист и вставляем в целевую книгу после 1-го листа.
'(в данном случае - после листа "Скрипт")
Sheets("FreeMind Sheet").Copy After:=Workbooks(f).Sheets(1)
Windows("MindMap (Excel).xml").Activate 'активируем вспомогательный ф-л
ActiveWorkbook.Close SaveChanges:=False 'закрываем его без сохранения
Windows(f).Activate 'активируем целевую книгу
Sheets("Скрипт").Select
ActiveWorkbook.Save
End Sub

[Completum]

Суть этого макроса в том, чтобы, выполнив его, удалялся 2-ой лист открытой книги и вместо него вставлялся новый из файла с расширением .xml Т.е. программа открывает файл с расширением .xml, копирует от туда лист (он там один), закрывает этот файл и вместо 2-го листа открытой книги вставляет новый (как я понимаю, удаляет 2-ой лист открытой книги и вставляет новый), т.е. как бы обновляет.

[Completum]

The_Prist, Вы мне скинули очень хороший макрос: он довольно обобщённый, и его, действительно, можно применять в различных случаях. Вы мне подсказали как его изменить под мой случай с 1-ой папкой. Получилось:

Код: (vb)

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    sFolder = ThisWorkbook.Path 
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
        ActiveWorkbook.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub

[Completum]

Фактически, нужно скомбинировать эти 2 макроса. У меня открытие файла начинается с 15-ой строки:

Код: (vb)

Workbooks.Open Filename:=ThisWorkbook.Path & "\MindMap (Excel).xml"

В Вашем коде, как я понимаю, с 10-ой:

Код: (vb)

Workbooks.Open sFolder & sFiles

У меня получилось нечто подобное:

Код: (vb)

Sub Только_тип_файла()
Dim sFolder As String, sFiles As String
Dim f As String
f = ActiveWorkbook.Name
'диалог запроса выбора папки с файлами
sFolder = ThisWorkbook.Path
sFolder = sFolder & IIf(Right(sFolder, 1) = _
Application.PathSeparator, "", Application.PathSeparator)
'отключаем обновление экрана, чтобы наши действия не мелькали
Application.ScreenUpdating = False
sFiles = Dir(sFolder & "*.xml*")
Do While sFiles <> ""
 'открываем книгу
 Workbooks.Open sFolder & sFiles
 'действия с файлом
 Sheets("FreeMind Sheet").Copy After:=Workbooks(f).Sheets(1)
 Windows(sFiles).Activate 'активируем вспомогательный ф-л
 ActiveWorkbook.Close SaveChanges:=False 'закрываем его без сохранения
 Windows(f).Activate 'активируем целевую книгу
 Sheets("Скрипт").Select
 ActiveWorkbook.Save
 'Закрываем книгу с сохранением изменений
 ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
 sFiles = Dir
Loop
'возвращаем ранее отключенное обновление экрана
Application.ScreenUpdating = True
End Sub

Ну, конечно же, это ...  ;D
Помогите, пожалуйста, довести до ума 

[Completum]

Скидываю 2 файла как пример (только вместо .xml будет .xlsx), но суть одна: возможность вместо MindMap (Excel) использовать разные названия.

[vikttur]

1. К незнакомым принято общаться на "Вы"
2. Не нужно излишне увлекатья картинками. Поведение барышни из соцсети...
3. У Вас недержание текста? Что это за очереди сообщений с макросами?! Вы же тему захламляете!
4. За частое поднятие темы - пока что устное замечание. При повторе нарушений -бан.
5. pton, к которому обращаетесь - невидимка?

[Completum]

Простите, пожалуйста 

[Дмитрий Щербаков(The_Prist)]

Почистил тему. И настоятельно рекомендую ознакомиться с правилами форума. Запрещено привлекать внимание к теме поднятием её бессмысленными сообщениями.
По теме: опишите своими словами чего Вы вообще хотите от кода. Я пока ничего не понял - что с чем Вы совмещаете и зачем. Вы привели какой-то код, просите довести до ума. До чьего? Мы же даже не знаем чего Вы хотите от него получить. Как же мы поможем? Каков должен быть итог?