Макрос - поиск самого нового файла

[inessam]

Здравствуйте,
создал в Excel макрос с кнопкой, который находит в строго определенном каталоге файл *.csv и затем специальным образом импортирует его содержимое в excel.
Но тут вспомнил, что версий таких файлов *.csv в этом каталоге может быть несколько (*.csv (1), *.csv (2), *.csv (3) и т.д.), а для макроса нужна самая последняя.

Может ли кто-то подсказать, как макрос может найти самую свежую (по дате)?
Сразу поясню, что с макросами знаком почти целых 50 минут и разбираюсь в них, можете себе представить, очень и очень ....
Так что очень прошу объяснить, как установить затем это чудо.

Сердечно благодарен!

[SAS888]

Можно, например, так:

Sub Main()
    Dim myPath As String, myName As String, f As String
    myPath = "C:\Temp\" 'Путь к папке с файлами
    myName = Dir(myPath & "*.csv")
    Do While myName <> ""
        If f = "" Then f = myName Else If FileDateTime(myPath & myName) > FileDateTime(myPath & f) Then f = myName
        myName = Dir
    Loop
    If f = "" Then MsgBox "Файлов с расширением csv в данной директории нет!" Else MsgBox f
End Sub

[EducatedFool]

http://excelvba.ru/code/LastFile

В вашем случае эту функцию можно использовать так:
(чтобы получить полный путь к самому новому файлу)

СамыйСвежийФайл$ = LastFile$(ПутьКПапке, ".csv*")

[inessam]

Огромное всем спасибо!!!
А как и куда записать это, если сам макрос, например, выглядит следующим образом:


Sub Макрос 1 ()
'
' Макрос 1 Макрос
' Макрос записан 07.04.2011 (IM)
'
' Сочетание клавиш: Ctrl+a
'
With ActiveSheet.QueryTables.Add(Connect ion:= _
"TEXT;C:\Users\Inna\Downloads\55.cs v", Destination:=Range("A1"))
.Name = "55"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 866
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

[EducatedFool]

Как-то так:

Sub Макрос1()
    ' ищем файл
    СамыйСвежийФайл$ = LastFile$("C:\Users\Inna\Downloads\", ".csv*")
    ' выполняем веб-запрос
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & СамыйСвежийФайл$, Destination:=Range("A1"))
        .Name = "55"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 866
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Вот только зачем вручную скачивать этот файл - когда макрос сам при запуске может скачать с интернета самый свежий файл?
Если вы вручную это делаете, - значит, и макросу это под силу...

[inessam]

Спасибо
Сейчас попробую и напишу результат.

[inessam]

Не выполняется.
Я ошибся, версия файла указывается в скобках сразу после самого имени файла, а не расширения (1,2,3,4 и т.д.)
У меня этот файл называется "Список заказов-export(),csv"

Но все равно не идет. Я написал:

Sub Макрос1()
' ищем файл
СамыйСвежийФайл$ = LastFile$("C:\Users\Inna\Downloads\Список заказов-export*.csv")
' выполняем веб-запрос
With ActiveSheet.QueryTables.Add(Connect ion:="TEXT;" & СамыйСвежийФайл$, Destination:=Range("A1"))
.Name = "Список заказов-export*"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 866
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

[EducatedFool]

Сообщение от inessam

Не выполняется.
Я написал:

Sub Макрос1()
' ищем файл
СамыйСвежийФайл$ = LastFile$("C:\Users\Inna\Downloads\Список заказов-export*.csv")

Недостаточно написать что-то с виду похожее на то, что я предложил
(если, конечно, хотите, чтобы макрос работал)

Обратите внимание - у функции 2 параметра, а вы всё в один слепили...

Для начала запустите такой макрос - и скажите, что выводится в сообщении:

Sub Макрос2()
    ' ищем файл
    СамыйСвежийФайл$ = LastFile$("C:\Users\Inna\Downloads\", ".csv")
    ' выводим его имя
    MsgBox СамыйСвежийФайл$, vbInformation
End Sub

[inessam]

Спасибо.
Посмотрите во вложении, что пишет в ответ...

[EducatedFool]

Посмотрите во вложении, что пишет в ответ...

Я зачем вам давал эту ссылку? http://excelvba.ru/code/LastFile
Наверное, для того, чтобы вы код функции скопировали в свой файл...

В итоге, ваш макрос будет выглядеть так:

Sub Макрос2()
    ' ищем файл
    СамыйСвежийФайл$ = LastFile$("C:\Users\Inna\Downloads\", ".csv")
    ' выводим его имя
    MsgBox СамыйСвежийФайл$, vbInformation
End Sub

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