как по макросу скопировать название имени фала в ячейку??

[kievlyanin]

в определенной папке есть файл у которого постоянно обновляется имя "файл_1" .. новая версия "файл_2" .. еще более новая "файл_3" и т.д. есть другой файл, который вытягивает из него определенную инфу.

данные, которые вытягиваются во второй файл вытягиваются посредством банального ВПР(), ГПР() и ПОИСКПОЗ() - в данной ситуации это наиболее удобно.

так вот, в эти функции ищут диапазоны из которых надо вытягивать данные через ДВССЫЛ в которой прописывается имя файла.

вопрос - как через макрос можно обновлять это имя??

т.е. надо чтобы при открытии, к примеру, ексель шел в определенную папку находил файл со словами в имени "файл", копировал имя файла полностью и вставлял в определенную ячейку в книге, после чего открывал эту книгу.

[pivas]

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

Sub Workbook_Open()
Dim i As Long, z As Long, ws As Worksheet, y As Variant
Dim fLdr As String
y = ".xls"
z = 1
fLdr = "C:\Мои документы"
Columns("A:A").Select
Selection.ClearContents
Range("A1").Select

With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If Left$(.FoundFiles(i), 1) = Left$(fLdr, 1) Then
z = z + 1
Лист1.Cells(z + 1, 1).Resize(, 1) = Array(Dir(.FoundFiles(i)))
End If
Next i
End If
End With

Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Workbooks.Open Filename:="C:\Мои документы\" & Range("A1")
End Sub

ЗЫ: Вместо C:\Мои документы укажите путь к папке, где лежат "файл_1" .. новая версия "файл_2". Макрос ищет все файлы с расширением .xls в указанной папке и записывает их в столбец А на Лист1, сортирует и в ячейке А1 получаем "старший" файл, который открывается.
Маленький нюанс: количество цифр в имени файла д.б. одинаковым для правильной сортировки. Т.е., если файлов больше 9 но меньше 100 имена должны начинаться с "файл_01".

[SAS888]

Метод FileSearch лучше не использовать. Microsoft считает его неперспективным и с версии 2007 он отключен.
Можно существенно проще:

Sub FileNameToCell()
    Dim myPath As String
    myPath = "D:\Temp\" 'Подставьте свой путь к папке с файлами
    [A1] = myPath & Dir(myPath & "*файл*.xls")
End Sub

В результате, в ячейке "A1" будет находиться первые попавшие под искомые требования путь и имя файла. Если такого файла нет - ячейка окажется пуста.

[kievlyanin]

2 SAS888

по поводу FileSearch - да, отключен .. я нашел примерчик с поиском файла по маске, но он у мена на седьмом экселе дает ошибку на FileSearch - пишет не поддерживается. собсно поэтому сюда и обратился.

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

[SAS888]

Строку кода

[A1] = myPath & Dir(myPath & "*файл*.xls")

замените на

[A1] = Dir(myPath & "*файл*.xls")

[kievlyanin]

2 SAS888



работает!!

спасибо!

[pivas]

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

[EducatedFool]

Sub ПолучениеСпискаФайловXLS()
    folder = "C:\Documents and Settings\Игорь\Рабочий стол\"

    ИмяФайла = Dir(folder & "*.xls")
    While ИмяФайла <> ""
        Debug.Print ИмяФайла
        ИмяФайла = Dir
    Wend
End Sub

[pivas]

Бесподобно. Преклоняюсь перед мастерством.