Список файлов в папке

источник https://www.planetaexcel.ru/techniques/3/45/

Sub FileList()

    Dim V As String

    Dim BrowseFolder As String

     

    'открываем диалоговое окно выбора папки

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = "Выберите папку или диск"

        .Show

        On Error Resume Next

        Err.Clear

        V = .SelectedItems(1)

        If Err.Number <> 0 Then

            MsgBox "Вы ничего не выбрали!"

            Exit Sub

        End If

    End With

    BrowseFolder = CStr(V)

     

    'добавляем лист и выводим на него шапку таблицы

    ActiveWorkbook.Sheets.Add

    With Range("A1:E1")

        .Font.Bold = True

        .Font.Size = 12

    End With

    Range("A1").Value = "Имя файла"

    Range("B1").Value = "Путь"

    Range("C1").Value = "Размер"

    Range("D1").Value = "Дата создания"

    Range("E1").Value = "Дата изменения"

     

    'вызываем процедуру вывода списка файлов

    'измените True на False, если не нужно выводить файлы из вложенных папок

    ListFilesInFolder BrowseFolder, True

End Sub

Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

    Dim FSO As Object

    Dim SourceFolder As Object

    Dim SubFolder As Object

    Dim FileItem As Object

    Dim r As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set SourceFolder = FSO.getfolder(SourceFolderName)

    r = Range("A65536").End(xlUp).Row + 1   'находим первую пустую строку

    'выводим данные по файлу

    For Each FileItem In SourceFolder.Files

        Cells(r, 1).Formula = FileItem.Name

        Cells(r, 2).Formula = FileItem.Path

        Cells(r, 3).Formula = FileItem.Size

        Cells(r, 4).Formula = FileItem.DateCreated

        Cells(r, 5).Formula = FileItem.DateLastModified

        r = r + 1

        X = SourceFolder.Path

    Next FileItem

     

    'вызываем процедуру повторно для каждой вложенной папки

    If IncludeSubfolders Then

        For Each SubFolder In SourceFolder.SubFolders

            ListFilesInFolder SubFolder.Path, True

        Next SubFolder

    End If

    Columns("A:E").AutoFit

    Set FileItem = Nothing

    Set SourceFolder = Nothing

    Set FSO = Nothing

End Sub



Если захотите, чтобы вместо пути к файлу в столбце B выводилась живая гиперссылка, то замените 52-ю строку
Cells(r, 2).Formula = FileItem.Path
на
Cells(r, 2).Formula = "=HYPERLINK(""" & FileItem.Path & """)"