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

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

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

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

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

3. В процедуре "ПолучитьПолныеИмена":
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 LCase(Mid(Файл.Name, InStrRev(Файл.Name, ".") + 1))
                Case "xlsb", "xlsx"
                    FNs.Add Item:=Файл.Path
            End Select
        End If
    Next Файл
   
End Sub