макрос на ссылку на послендную добавленную книгу

[Фонарик2]

Доброго времени суток, формучане!

У меня такая задача: нужен макрос который будет открывать последнюю добавленную книгу(эксель) в папке, отмечу что файлы хранятся по дате автовыгрузки.

Не знаю что написать в path чтобы он открывал последнюю книгу.

Function NameOpenedBookDialog() As String
Dim dlgOpen As FileDialog, FN As String, wb As Workbook
Set dlgOpen = Application.FileDialog(1)
dlgOpen.InitialFileName = ThisWorkbook.Path & "\"
dlgOpen.Show
If dlgOpen.SelectedItems.Count > 0 Then
FN = dlgOpen.SelectedItems(1)
Set wb = Workbooks.Open(FN)
NameOpenedBookDialog = wb.Name
End If
Set dlgOpen = Nothing
Set wb = Nothing
End Function

Буду признательна за помощь!

[Aleksandr H.]

http://excelvba.ru/code/LastFile

[Фонарик2]

Aleksandr H. , в этом деле я чайник, попробовала вставить в path, данные со ссылки, выдает ошибки, интуитивно знаю что делаю неправильно. Можете мне помочь? получается в этот макрос нужно вставить путь на самый свежий файл в папке, он эклелевский, в примере кажется ткестук был.

[Фонарик2]

а еще мне нужно не только найти книгу, но и открыть нужно

[Aleksandr H.]

Ну так пропишите выбор папки и запуск книги в процедуре ПримерИспользованияФункции_LastFile () и запустите её

Function LastFile$(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                   Optional ByVal SearchDeep As Long = 999)
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут проверены только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает полный путь к файлу, имеющему самую позднюю дату создания
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Dim FilenamesCollection As New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep    ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
    Dim maxFileDate As Double
    For Each file In FilenamesCollection ' перебираем все файлы среди найденных
        currFileDate = FileDateTime(file) ' считываем дату последнего сохранения
        ' проверяем очередной файл - не новее ли он предыдущих
        If currFileDate > maxFileDate Then LastFile$ = file: maxFileDate = currFileDate
    Next file
End Function
 
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке
        Application.StatusBar = "Поиск в папке: " & FolderPath
 
        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже
            For Each sfol In curfold.SubFolders    ' ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function

Sub ПримерИспользованияФункции_LastFile()
    
    ' Ищем на рабочем столе все файлы TXT, и выводим имя самого нового файла.
    ' Просматриваются папки с глубиной вложения не более трёх.

    Dim ПутьКПапке$, СамыйПоследнийФайл$
    Dim wb As Workbook
    ' получаем путь к папке РАБОЧИЙ СТОЛ
    ПутьКПапке = GetFolder(CreateObject("WScript.Shell").SpecialFolders("Desktop"))
    ' получаем путь к самому новому файлу (проверяется дата последнего сохранения)
    СамыйПоследнийФайл$ = LastFile$(ПутьКПапке, ".xlsx", 3)
    If СамыйПоследнийФайл$ = "" Then MsgBox "Не найдено ни одного файла", vbExclamation: Exit Sub
    MsgBox СамыйПоследнийФайл$, vbInformation, "Самый свежий файл"
    Set wb = Workbooks.Open(СамыйПоследнийФайл$)
    
End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

[Фонарик2]

Спасибо!
Сейчас попробую

[IgorGO]

положите файл в папку с выгрузками
открываейте его... (ВНИМАНИЕ! открывайте не из архива, а положите в папку с выгрузками и открывайте от туда!)
вместо него откроется самый "младший" xls-файл в папке

Private Sub workbook_open()
  Dim dt As Date, dtM As Date, pt$, fn$, f1$
  pt = ThisWorkbook.Path & Application.PathSeparator
  fn = Dir(pt & "*.xls*"):  If fn <> "" Then f1 = fn: dtM = FileDateTime(pt & f1)
  Do While fn <> ""
    If fn <> ThisWorkbook.Name Then
      dt = FileDateTime(pt & fn): If dt > dtM Then dtM = dt: f1 = fn
    End If
    fn = Dir()
  Loop
  If f1 <> "" Then Workbooks.Open pt & f1
  ThisWorkbook.Close
End Sub

удачи!

[Фонарик2]

IgorGO СПАСИБО!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!


работает