Андрей 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 |