Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA Как отобразить путь САМОЙ МОЛОДОЙ ПАПКИ в директории
 
Доброго времени суток, уважаемые!

Будьте любезны, подскажите, каким образом возможно узнать имя самой молодой папки, например, в ThisWorkBook.path.
В силу несильной квалифицированности не могу сообразить способ реализации. Подскажите, пожалуйста, кому известно либо, у кого есть какие-нибудь соображению на этот счет.

Благодарю!
Изменено: falm̅̅̃̄̅̂̂̈̄̀̀̀̀̆̄̂́́̀̄̀̂̂̂̈̈̃́̂̆̂̀̆̀̃́̆̀̂̀̀̈̆rom - 24 Апр 2019 13:46:13
Улыбнись.
 
Доброе время суток.
Например так, построить таблицу подпапок и найти нужную по дате.
 
Андрей VG, спасибо. Сейчас вникну в код, дам обратную связь.
Улыбнись.
 
Андрей VG, все ок. Я внес свои несильно изящные корректировки и теперь по итогу выполнения отображается ИМЯ самой МОЛОДОЙ папки.
Спасибо Вам.

Код прикладываю:
Код
Public Sub scanFolders()
    Dim fso As Object, idRow As Long, ПутьДоПапки$
    Set fso = CreateObject("Scripting.FileSystemObject")
    idRow = 1
    
    ПутьДоПапки = "C:\Users\timin\Desktop\Газпром-помощник"
    
    
    Worksheets.Add.Name = "ЛистДиректории"
    Sheets("ЛистДиректории").Select
 
    scanNextFolder ActiveSheet, idRow, fso.GetFolder(ПутьДоПапки), 0

    Range("A1").Value = "имя"
    Range("B1").Value = "путь"
    Range("C1").Value = "дата создания"
    Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row).Select
    Selection.AutoFilter
    'ActiveWorkbook.Worksheets("ЛистДиректории").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ЛистДиректории").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "C1:C" & Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("ЛистДиректории").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ПутьДоПапки = Range("B" & Cells(Rows.Count, 1).End(xlUp).Row).Value

    Sheets("ЛистДиректории").Delete
    
    MsgBox ПутьДоПапки
End Sub
 
Private Sub scanNextFolder(ByVal outSheet As Worksheet, ByRef idRow As Long, ByVal parentFolder As Object, ByVal depth As Long)
    Dim outRow(1 To 6) As Variant, childFolder As Object                                      
                                       
    depth = depth + 1
    outRow(1) = parentFolder.Name
    outRow(2) = parentFolder.Path
    outRow(3) = parentFolder.DateCreated
    outRow(4) = parentFolder.DateLastModified
    outRow(5) = parentFolder.DateLastAccessed
    outRow(6) = depth
    idRow = idRow + 1
    outSheet.Range(outSheet.Cells(idRow, 1), outSheet.Cells(idRow, 6)).Value = outRow
    For Each childFolder In parentFolder.SubFolders
        scanNextFolder outSheet, idRow, childFolder, depth
    Next 
End Sub
Изменено: falm̅̅̃̄̅̂̂̈̄̀̀̀̀̆̄̂́́̀̄̀̂̂̂̈̈̃́̂̆̂̀̆̀̃́̆̀̂̀̀̈̆rom - 24 Апр 2019 13:46:44
Улыбнись.
 
OFF falm̅̅̃̄̅̂̂̈̄̀̀̀̀̆̄̂́́̀̄̀̂̂̂̈̈̃́̂̆̂̀̆̀̃́̆̀̂̀̀̈̆rom, Вы бы со своим ником и подписью сделали что нибудь, а то ВОТ (сообщения 110 - 116)
falmron.jpg (64.6 КБ)
Согласие есть продукт при полном непротивлении сторон.
 
Код
dir /s /ad /o-d
?
 
Казанский, спасибо. Решение уже сформулировано несколькими постами ранее. =)
Улыбнись.
Страницы: 1
Читают тему (гостей: 1)
Наверх