📂 Просмотр содержимого папки в VBA Excel
Если вам нужно получить список подпапок или файлов из определенной папки в Excel, VBA легко справится с этой задачей!

1️⃣ Просмотр подпапок в выбранной папке:

Sub ПросмотрПапок()
    Dim ws As Worksheet
    Dim FSO As Object
    Dim FolderPath As String
    Dim SubFolder As Object
    Dim FolderDialog As Object
    Dim Row As Integer
    
    ' Выбор папки через диалоговое окно
    Set FolderDialog = Application.FileDialog(4) ' 4 – выбор папки
    If FolderDialog.Show = -1 Then
        FolderPath = FolderDialog.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' Работа с подпапками
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Sheets(1)
    
    ws.Cells.Clear ' Очистка листа перед вставкой данных
    ws.Cells(1, 1).Value = "Папки в: " & FolderPath
    ws.Cells(2, 1).Value = "Имя папки"
    
    Row = 3
    For Each SubFolder In FSO.GetFolder(FolderPath).SubFolders
        ws.Cells(Row, 1).Value = SubFolder.Name
        Row = Row + 1
    Next SubFolder
    
    MsgBox "Просмотр завершен! Найдено " & Row - 3 & " папок.", vbInformation, "Готово"
    
End Sub

🔹 Как это работает?
✅ Открывается диалоговое окно для выбора папки 📁
✅ Код перебирает файлы в выбранной папке и записывает их имена на лист Excel 📜
✅ Показывается сообщение о завершении работы 🚀

2️⃣ Просмотр файлов в выбранной папке:

Sub ПросмотрФайлов()
    Dim ws As Worksheet
    Dim FSO As Object
    Dim FolderPath As String
    Dim FileItem As Object
    Dim FolderDialog As Object
    Dim Row As Integer
    
    ' Выбор папки через диалоговое окно
    Set FolderDialog = Application.FileDialog(4) ' 4 – выбор папки
    If FolderDialog.Show = -1 Then
        FolderPath = FolderDialog.SelectedItems(1)
    Else
        Exit Sub
    End If

    ' Работа с файлами в папке
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Sheets(1)
    
    ws.Cells.Clear ' Очистка листа перед вставкой данных
    ws.Cells(1, 1).Value = "Файлы в папке: " & FolderPath
    ws.Cells(2, 1).Value = "Имя файла"
    
    Row = 3
    For Each FileItem In FSO.GetFolder(FolderPath).Files
        ws.Cells(Row, 1).Value = FileItem.Name
        Row = Row + 1
    Next FileItem
    
    MsgBox "Просмотр завершен! Найдено " & Row - 3 & " файлов.", vbInformation, "Готово"
    
End Sub

🔹 Как работает этот код?
✅ Открывает диалоговое окно для выбора папки 📂
✅ Перебирает папки внутри выбранной директории и выводит их список на лист Excel 📜
✅ Показывает уведомление о завершении 🚀

#VBA #ExcelVBA #GetFolder #SubFolders #Files