открытие последний созданный файл в папке

Пользователь

Сообщений: 112 Регистрация: 17.01.2013

15.07.2011 09:02:26

Всем доброй пятницы!!!
помогите переделать макрос взятый поиском на форуме.

в папку \\аsu\pogruzka\DANN
складывается почта приходящая несколько раз в день, нужно по запуску макроса открывать последний помещенный файл в указанную папку.
формат файлов следующий:
ВСЖДЛ ДАННЫЕ ОТГРУЗКИ 29.06.11 08.00 .xls
ВСЖДЛ ДАННЫЕ ОТГРУЗКИ 12.07.11 09.00 .xls
ВСЖДЛ ДАННЫЕ ОТГРУЗКИ 14.07.11 11.54 .xls
ВСЖДЛ ДАННЫЕ ОТГРУЗКИ 15.07.11 14.00 .xls

вот пример кода взятый на форуме

Function last_open(pt) As String
Dim fs As FileSearch
Dim lad As Date, cad As Date
cad = CDate("1/1/1980")
With Application.FileSearch
.NewSearch
.LookIn = pt
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = False
.FileType = msoFileTypeExcelWorkbooks
End With

With Application.FileSearch
If .Execute() > 0 Then
Set fs1 = CreateObject("Scripting.FileSystemObject")
For i = 1 To .FoundFiles.Count
Set f = fs1.GetFile(.FoundFiles(i))
lad = CDate(f.DateLastModified)
If lad > cad Then
cad = lad: fn = .FoundFiles(i)
End If
Next i
last_open = fn
Else
MsgBox "В папке " & pt & "XLS файлов не найдено"
last_open=""
End If
End With
End Function

webley Пользователь Сообщений: 2174 Регистрация: 01.01.1970	#2 15.07.2011 09:25:26 последний помещенный или последний по дате, указанной в названии?

Cloud_000 Пользователь Сообщений: 112 Регистрация: 17.01.2013	#3 15.07.2011 09:27:34 последний по дате и времени указанный в названии

webley

Пользователь

Сообщений: 2174 Регистрация: 01.01.1970

15.07.2011 09:45:39

ну вот что-нибудь в этом роде

Sub FOpen() 'в references надо подключить библиотеку Microsoft Scripting Runtime!!!
Dim FSO As New FileSystemObject
Dim f As File

Dim maxDate As Date
Dim fileName As String

maxDate = 1
For Each f In FSO.GetFolder("\\аsu\pogruzka\DANN").Files
If maxDate < Format(Mid(f.Name, 23, 8) & " " & Replace(Mid(f.Name, 33, 5), ".", ":"), "General Date") Then
maxDate = Format(Mid(f.Name, 23, 8) & " " & Replace(Mid(f.Name, 33, 5), ".", ":"), "General Date")
fileName = f.Path
End If
Next f
Workbooks.Open fileName
End Sub

слэн

Пользователь

Сообщений: 5192 Регистрация: 16.01.2013

15.07.2011 09:58:42

или вот переделка:

Function last_open(pt) As String
Dim fs As FileSearch
Dim lad As Date, cad As Date
cad = CDate("1/1/1980")
With Application.FileSearch
.NewSearch
.LookIn = pt
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = False
.FileType = msoFileTypeExcelWorkbooks
End With

With Application.FileSearch
If .Execute() > 0 Then
Set fs1 = CreateObject("Scripting.FileSystemObject")
For i = 1 To .FoundFiles.Count
lad = .FoundFiles(i)
lad = Left(lad, Len(lad) - 4)
lad = Right(lad, 14)
lad = CDate(StrReverse(Replace(StrReverse(lad), ".", ":", 1, 1)))
If lad > cad Then
cad = lad: fn = .FoundFiles(i)
End If
Next i
last_open = fn
Else
MsgBox "В папке " & pt & "XLS файлов не найдено"
last_open = ""
End If
End With
End Function
правда не проверял..

Живи и дай жить..

EducatedFool Пользователь Сообщений: 3695 Регистрация: 23.12.2012	#6 15.07.2011 10:04:31 А готовое решение поискать в интернете не пробовали? http://excelvba.ru/code/LastFile Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Cloud_000 Пользователь Сообщений: 112 Регистрация: 17.01.2013	#7 15.07.2011 11:18:58 webley Огромное спасибо - разобрался - все работает Всем тоже огромное спасибо за участие

Читают тему