Добрый день! Столкнулся с такой задачей. Нужен макрос который ищет файл по дате (последний созданный) с расширением .sto в определенной папке, и копирует его имя в ячейку. Нашел подобие, но реализовать как то не получается. Помогите пожалуйста. Вот что я нашел похожее: https://www.planetaexcel.ru/techniques/3/45/
А что именно не получилось? загоните в массив названия файлов и дату создания, затем отфильтруйте массив по возрастанию и берите значения если нужен самый первый файл, то значение первого индекса массива, иначе последнее. Тут вроде как ничего сложного нет. Можно без сортировки и массива, просто перебирая файлы по условию назначать переменной имя файла который был создан позднее, и в итоге присваиваете нужной ячейке значение переменной содержащей имя файла.
Nordheim написал: Можно без сортировки и массива, просто перебирая файлы по условию назначать переменной имя файла который был создан позднее, и в итоге присваиваете нужной ячейке значение переменной содержащей имя файла.
Вот это был бы идеальный вариант, я конечно не профи как ты, думаю сам врятли справлюсь...
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
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
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