Автор Тема: VBA Макросы: Как получить полные имена файлов, которые находятся в указанной папке.  (Прочитано 239 раз)

Оффлайн Администратор

  • Administrator
  • Сообщений: 1726
В этой теме рассматривается ситуация, если нужно просмотреть содержимое одной папки. Если нужно просмотреть содержимое вложенных папок, то в этой теме нет этой информации.

1. Это код для виндоуса. Для мака нужно писать другой код.

2. Вверху модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1

3. Подключите библиотеку:
Tools - References... - Microsoft Scripting Runtime

4. В процедуре "ПолучитьПолныеИмена":
1) в пункте 2 укажите полное имя (путь + имя) папки, которую надо просмотреть. На конце слеш не указывайте;
2) в пункте 4 укажите нужные расширения через запятую, как сейчас сделано.

Макрос
Sub Адаптер()

    Dim FNs As Collection
   
   
    ' Записываем в коллекцию "FNs" полные имена файлов, которые находятся
        ' в указанной папке
    ПолучитьПолныеИмена FNs

End Sub

Private Sub ПолучитьПолныеИмена(FNs As Collection)

    Dim fso As Scripting.FileSystemObject
    Dim папка As Scripting.Folder, файл As Scripting.File
   
   
    '1. Создание объекта, который умеет работать с папками и файлами.
    Set fso = New FileSystemObject
   
    '2. Присваиваем имя папке, с которой надо работать.
    ' Здесь укажите полное имя папки. На конце слеш не нужно указывать.
    Set папка = fso.GetFolder("C:\Users\User\Desktop\Файлы")
   
    '3. Создание коллекции.
    Set FNs = New Collection
   
    '4. Запись в коллекцию полных имён файлов, которые находятся в указанной папке.
        ' Если эксель-файл открыт, то в папке будет скрытый файл, относящийся к этому файлу.
        ' Поэтому делается проверка, что файл не скрытый.
    For Each файл In папка.Files
        If (файл.Attributes And Hidden) = 0 Then
            Select Case Mid(файл.Name, InStrRev(файл.Name, ".") + 1)
                Case "xlsb", "xlsx"
                    FNs.Add item:=файл.Path
            End Select
        End If
    Next файл
   
End Sub