Страницы: 1
RSS
открыть последний файл в папке по дате создания
 
Добрый день!
Подскажите, пожалуйста, как с помощью макроса найти в папке файл с определенным расширением с последний датой создания?
Предположим есть папка, в которой несколько файлов:
название   дата создания    дата изменения
1.txt     01.01.2014  01.08.2014
2.xls    04.08.2014  06.08.2014
3.xls    05.08.2014  05.08.2014  
4.xls    01.08.2014  08.08.2014

По результатам работы макроса должен открыться файл 3.xls
Заранее спасибо.
 
Здравствуйте. А не хотите после создания списка всех файлов в папке, указать на файл который необходимо открыть?
Изменено: gling - 07.08.2014 20:56:00
 
Дело в том, что файлов в папке может быть очень много и макрос, скорее всего, будет слишком долго выстраивать список.
 
Долго ли, коротко ли, но пока макрос список не выстроит, он последний файл не найдет.
Рыбка
Изменено: RAN - 11.08.2014 01:22:58
 
Спасибо за ссылку, но это не то. По ссылке создается таблица, а она не нужна, нужно открыть только последний по дате создания файл.
 
Это  именно то. А то, что вы не знаете, что с ним делать, вопрос отдельный.  :)
 
Код
Sub get_first_created()
Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object
myPath = "C:\Users\Вася\Downloads\" ' директория для поиска
mask = "*ampl*.xls" ' маска поиска с * и ?
With CreateObject("Scripting.FileSystemObject")
    Set myFolder = .GetFolder(myPath)
    t = Now ' если ищем самый поздний - убрать эту строку
    For Each myFile In myFolder.Files
        If myFile.Name Like mask Then
            If CDate(myFile.DateCreated) < t Then ' если ищем самый ранний, то  <, самый поздний  - >
                t = CDate(myFile.DateCreated)
                f = myFile.Name
            End If
        End If
    Next
End With
If f <> "" Then MsgBox "File found: " & f & ", " & t Else MsgBox "No such file"
End Sub 
Изменено: Максим Зеленский - 08.08.2014 00:29:21
F1 творит чудеса
 
Как вариант:
http://excelvba.ru/code/lastfile
 
Игорь, добрый день!
Данный вариант очень хороший, но не подходит, так как строка  currFileDate = FileDateTime(file) определяет последний файл, в т.ч. и по времени сохранения. Я пытался заменить FileDateTime(file), чтобы определялась только дата создания, но ничего не получилось(  Если знаете, как изменить код на дату создания, то подскажите, пожалуйста. Заранее спасибо!
   Максим Зеленский , классный вариант, спасибо большущее) Подскажите. пожалуйста, а что означают символы $ и % при определении переменных? И в коде я не нашел переменную i - она была добавлена случайно?
Изменено: dmt. - 11.08.2014 01:23:55
 
да, i там случайно. $ - это string, % - integer
F1 творит чудеса
 
Максим в вашем коде насколько я понимаю, выводиться сообщение о том что последний файл найден. А можно чтобы он ещё открывался?
 
Код
Sub get_first_created()
Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object
Dim S As Object
Set S = CreateObject("Shell.Application")
myPath = "C:\Users\Вася\Downloads\" ' директория для поиска
mask = "*ТОРГ-12*.xlsx" ' маска поиска с * и ?
With CreateObject("Scripting.FileSystemObject")
    Set myFolder = .GetFolder(myPath)
    t = Now ' если ищем самый поздний - убрать эту строку
    For Each myFile In myFolder.Files
        If myFile.Name Like mask Then
            If CDate(myFile.DateCreated) < t Then ' если ищем самый ранний, то  <, самый поздний  - >
                t = CDate(myFile.DateCreated)
                f = myFile.Name
                p = myFile.Path
            End If
        End If
    Next
On Error Resume Next
S.Open (p)
End With
End Sub
 
Спасибо огромное работает!!!
 
Добрый день!
Спасибо за макрос.
Подскажите, как открыть найденный объект (p) в режиме "только чтение"? Ставлю ReadOnly:=True но не работает...
Изменено: choreo - 24.01.2019 13:01:43
 
В вашем случае нужен Workbooks.Open
Изменено: magistor8 - 24.01.2019 14:10:14
 
Добрый день!
помогите дополнить эту программу, чтоб после нахождения последнего файла вся информация из него копировалась в тот файл где запускается макрос.
 
Тема про открытие файла, а Ваш вопрос про копирование. Следовательно, никакого отношения к заданной теме вопрос не имеет.
P.S. Чтобы скопировать всю информацию, макрос должен знать, что следует понимать под выражением "вся информация" : все таблицы со всех листов, все рисунки, диаграммы, примечания,..
Вот Вы, прочитав такое определение, смогли бы понять, что именно и куда нужно копировать?
 
Эта программа частично решает мою задачу, а она в том что в определенную папку генерируются файлы, нужно выбрать последний и с его первой страницы все данные с ячеек перенести в  файл в котором запускается макрос
 
Цитата
cust написал:
Эта программа частично решает мою задачу
Ключевое здесь: "частично". А зайдёт в эту тему человек, у которого тоже "частично" - в последнем файле нужно построить диаграмму. И вопрос он задаст соответствующий: как мне по данным из последнего файла построить диаграмму.
Следующему гостю потребуется извлечь уникальные значения, следующему создать выпадающие списки... И всё это в теме про последний по дате файл?
Удивляюсь, что нужно это объяснять.
 
Ну раз описание такое "полное", то и ответ полностью по задаче. После
Код
Workbooks.Open (p)
пишите:
Код
ActiveWorkbook.Sheets(1).Usedrange.Copy Thisworkbook.sheets(1).Cells(1,1)
Будут скопированы все данные из первого листа последнего файла в первый лист книги с макросом.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Огромное Спасибо!
 
Ребята, у меня на Виндовсе 10 этот скрипт не работал должным образом. Я его немного подправил.
Суть в том, что у меня в переменную t скрипта Максим Зеленский на 12 строке, попадает, после первого прогона в цикле, дата самого старого файла, из-за этого ломалось выполнение условия в строке: " If CDate(myFile.DateCreated) < t Then" (11 строка), так как ВБА искало мне файлы старее самого старого файла, что нелогично.

А вот так работает:
Код
Sub get_first_created()

Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object
myPath = "C:\Users\obarsukov\Downloads" ' директория для поиска
mask = "*.xls" ' маска поиска с * и ?
t = Now 
a = 1

With CreateObject("Scripting.FileSystemObject")
    Set myFolder = .GetFolder(myPath)
    For Each myFile In myFolder.Files
        If myFile.Name Like mask And a = 1 Then
            If CDate(myFile.DateCreated) <= t Then
                t = CDate(myFile.DateCreated)
                f = myFile.Name
                a = 0
            End If
            
        Else
             If CDate(myFile.DateCreated) > t Then
                t = CDate(myFile.DateCreated)
                f = myFile.Name
                
            End If
        
        End If
    Next
End With
If f <> "" Then MsgBox "File found: " & f & ", " & t Else MsgBox "No such file"
End Sub
Изменено: Arrio - 09.10.2021 19:33:26
 
Здравствуйте. Нужна помощь. Требуется макрос , который открывает по указанному пути папку, находит в ней самый последний файл по времени дате , и открывает его .
Путь к папке прописывается в макросе и не меняется.
А в общих чертах - есть папка, куда пишутся видео файлы. При запуске макроса надо чтобы из этой папки открылся последний записанный файл.
 
Код
Const myPATH = "C:\temp\"

Sub Test()
    OpenLastModifiedFile myPATH
End Sub

Public Function OpenLastModifiedFile(sPath As String) As Workbook
    Dim sFile As String
    sFile = LastModifiedFile(sPath)
    If sFile <> "" Then
        Set OpenLastModifiedFile = Workbooks.Open(sFile)
    End If
End Function

Public Function LastModifiedFile(sPath As String) As String
    Dim fso As Object:    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(sPath) Then Exit Function
    Dim dtCur As Date
    Dim dtMax As Date
    Dim sFile As String
    Dim oFile As Object
    For Each oFile In fso.GetFolder(sPath).Files
        If OkFile(oFile.Name, fso) Then
            dtCur = oFile.DateLastModified
            If dtMax < dtCur Then
                dtMax = dtCur
                sFile = oFile
            End If
        End If
    Next
    
    LastModifiedFile = sFile
End Function

Private Function OkFile(sName As String, fso As Object) As Boolean
    If Left(sName, 2) <> "~$" Then
        Select Case fso.GetExtensionName(sName)
        Case "xlsx", "xlsm", "xlsb"
            OkFile = True
        End Select
    End If
End Function
Страницы: 1
Наверх