Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос который копирует название файла с определенным расширением в определенной папке в ячейку, последний созданный.
 
Добрый день! Столкнулся с такой задачей. Нужен макрос который ищет файл по дате (последний созданный) с расширением .sto в определенной папке, и копирует его имя в ячейку.
Нашел подобие, но реализовать как то не получается. Помогите пожалуйста. Вот что я нашел похожее: https://www.planetaexcel.ru/techniques/3/45/
 
А что именно не получилось? загоните в массив названия файлов и дату создания, затем отфильтруйте массив по возрастанию и берите значения если нужен самый первый файл, то значение первого индекса массива, иначе последнее. Тут вроде как ничего сложного нет. Можно без сортировки и массива, просто перебирая файлы по условию назначать переменной имя файла который был создан позднее, и в итоге присваиваете нужной ячейке значение переменной содержащей имя файла.
Изменено: Nordheim - 30 апр 2019 10:00:00
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
Можно без сортировки и массива, просто перебирая файлы по условию назначать переменной имя файла который был создан позднее, и в итоге присваиваете нужной ячейке значение переменной содержащей имя файла.
Вот это был бы идеальный вариант, я конечно не профи как ты, думаю сам врятли справлюсь...
 
Покажите ваши наработки, по ним можно будет определить что исправить, с нуля нет времени писать.
"Все гениальное просто, а все простое гениально!!!"
 
vendigo, если имя файла не содержит русских букв, можно сделать очень просто:
Код
range("A1")=CreateObject("WScript.Shell").Exec("cmd /c dir /a-d /o-d /b C:\temp\*.sto").StdOut.readline
Здесь берется файл из папки C:\temp\
 
Код
Sub test()
    Dim objFSO As Object
    Dim ikey As Object
    Dim iPath$, fname$, dt As Date
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then iPath = .SelectedItems(1) Else Exit Sub
    End With
    With objFSO.GetFolder(iPath)
       For Each ikey In .Files
            If Right$(ikey.Name, Len(ikey.Name) - InStrRev(ikey.Name, ".")) = "sto" Then
                If fname = "" Then fname = ikey.Name: dt = ikey.DateCreated
                If dt < ikey.DateCreated Then fname = ikey.Name: dt = ikey.DateCreated
            End If
        Next ikey
    End With
    ActiveWorkbook.ActiveSheet.[a1] = fname
End Sub
Изменено: Nordheim - 30 апр 2019 12:12:18
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Казанский написал:
если имя файла не содержит русских букв
А если содержит, должно помочь такое "извращение" (правда, подмигивает :) ):
Код
Range("A1") = CreateObject("WScript.Shell").Exec("cmd /c chcp 1251|dir /a-d /o-d /b C:\temp\temp\*.*").StdOut.readline
Изменено: sokol92 - 30 апр 2019 13:59:42
Владимир
 
sokol92, у меня не работает (WinXP). Работает так
Код
Declare Sub OemToChar Lib "user32" Alias "OemToCharA" (ByVal Src As String, ByVal Dst As String)

Sub Макрос2()
Dim s$
  s = CreateObject("WScript.Shell").Exec("cmd /c dir /a-d /o-d /b C:\temp\*.sto").StdOut.readline
  OemToChar s, s
  Range("A1") = s
End Sub
 
Алексей, проверил для комбинации Win XP + Excel 2007 - у меня работает, даже "ё" выводит в названии файла. А у Вас не перекодирует имя файла?
Владимир
 
В общем снимаю шляпу... Только не работает чего то.  :)  Раз уж почти готово, давайте уж доделаем, надо чтоб искало автоматом скажем так \\server\test
 
Проверил на реальном сетевом диске. Работает.
Код
Sub test()
Range("A1") = CreateObject("WScript.Shell").Exec("cmd /c  chcp 1251 | dir /a-d /o-d /b dir \\helios\work9\O_XXX\XXX\XLS\FORMS\Tests\*.*").StdOut.readline
End Sub
Изменено: sokol92 - 30 апр 2019 17:00:51
Владимир
 
Все всем спасибо огромнейшее, все замутил ))) Просто супер !
 
Цитата
vendigo написал:
давайте уж доделаем
:)
Страницы: 1
Читают тему (гостей: 1)
Наверх