MyTetra Share
Делитесь знаниями!
Просмотр содержимого папки (каталога)
16.03.2019
23:43
Раздел: !Закладки - VBA - GetOpen
Просмотр содержимого папки (каталога)

(обращений: 1576 с 28.04.2016)

Разделы:  Полезные функции, ЧаВо (FAQ)

 

Описание: Для начинающих. Всё ясно из названия.

Автор: Дмитрий Сонных (AKA Joss)

Добавил на сайт: Профиль пользователяJoss 28.04.2016

Иногда, для автоматизации процесса загрузки однотипных данных пришедших из разных источников, необходимо определить содержимое нужной папки (каталога). Проще говоря получить список находящихся в ней файлов. Это можно сделать при помощи следующего кода

Dim strFolder As String

Dim Path As String, fName As String, i As Integer


strFolder = "c:\ImportXLS\"


Path = strFolder & "*.*" ' можно и "*.xls"

fName = Dir(Path)

If Len(fName) = 0 Then

Debug.Print "Папка пуста"

Else

i = 0

Do While fName <> ""

i = i + 1

Debug.Print i, fName

fName = Dir

Loop

Debug.Print "Просмотр окончек"

End If


Пример взят с сайта SQL.RU

P.S. Первоначально пробовал написать пример с помощью FileSystemObject, но оказалось, что в семействе Files к объектам File можно обращаться только по именам, а не по номеру в семействе. А жаль.

[Back]


Текущий рейтинг:
0 из 5 (проголосовало:0).
Здравствуйте!
Для участия в рейтинге необходимо залогиниться на сайт.
Это сделано для того, чтобы более точно производить оценку статей (чтобы одному и тому же человеку было труднее голосовать несколько раз, портя тем самым статистику.
Эта процедура очень быстрая и, надеюсь, Вас не затруднит :).
Все мысли по поводу работы сайта всегда можно высказать на форуме!
Вход на сайт

Обсуждение статьи:   
Примечание к примеру Профиль пользователяJoss   
Если в оператор

fName = Dir(Path)


добавить параметр vbDirectory, то будут выведены так же папки, входящие в указанную папку и ссылки на вышестоящую ".." и корневую "." папки.

fName = Dir(Path, vbDirectory)


06.04.2016 13:33

Ещё раз о FileSystemObject Профиль пользователяJoss   
Всё-таки и при помощи FileSystemObject можно получить список файлов. Но через коллекцию.

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _

Optional ByVal SearchDeep As Long = 999) As Collection

' Получает в качестве параметра путь к папке FolderPath,

' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)

' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).

' Возвращает коллекцию, содержащую полные пути найденных файлов

' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

Dim FSO As Object


Set FilenamesCollection = New Collection ' создаём пустую коллекцию

Set FSO = CreateObject("Scripting.FileSystemObject") ' создаём экземпляр FileSystemObject

GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск

Set FSO = Nothing ' очистка строки состояния Excel

End Function


Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _

ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)

' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO

' перебор папок осуществляется в том случае, если SearchDeep > 1

' добавляет пути найденных файлов в коллекцию FileNamesColl

On Error Resume Next

Dim curfold As Object

Dim fil As Object

Dim sfol As Variant

Set curfold = FSO.GetFolder(FolderPath)

If Not curfold Is Nothing Then ' если удалось получить доступ к папке

' раскомментируйте эту строку для вывода пути к просматриваемой

' в текущий момент папке в строку состояния Excel

' Application.StatusBar = "Поиск в папке: " & FolderPath

For Each fil In curfold.Files ' перебираем все файлы в папке FolderPath

If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path

Next

SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках

If SearchDeep Then ' если надо искать глубже

For Each sfol In curfold.SubFolders ' перебираем все подпапки в папке FolderPath

GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep

Next

End If

Set fil = Nothing

Set curfold = Nothing ' очищаем переменные

End If

End Function



Ну и пример использования. Обрабатывается не только папка, но и входящие в неё подпапки

Public Sub FileInFolder()

' Пример использования функции

On Error GoTo FileInFolder_Error

Dim folder$, coll As Collection, File


folder$ = "\\I-server-one\shara\ОНС_модуль_загрузка\"

If Dir(folder$, vbDirectory) = "" Then

MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Нет папки"

Exit Sub ' выход, если папка не найдена

End If


Set coll = FilenamesCollection(folder$) ' можно и так (folder$, "*.xls") - получаем список файлов XLS из папки

If coll.Count = 0 Then

MsgBox "В папке «" & Split(folder$, "\")(UBound(Split(folder$, "\")) - 1) & _

"» нет ни одного подходящего файла!", _

vbCritical, "Файлы для обработки не найдены"

Exit Sub ' выход, если нет файлов

End If


' перебираем все найденные файлы

For Each File In coll

Debug.Print File ' выводим имя файла в окно Immediate

Next


Exit_FileInFolder:


On Error GoTo 0

Exit Sub


FileInFolder_Error:


MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FileInFolder"

Resume Exit_FileInFolder


End Sub



Источник тот же.
06.04.2016 13:50 (последнее изменение - 06.04.2016 14:02) 

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования