| Главная | Мой профиль | Регистрация | Выход | Вход | RSS | Суббота, 27.04.2024, 02:10 |
Клуб развития интеллекта "Matrix" | |
| Вы вошли как Барабулька Группа "Гости"Приветствую Вас Барабулька |
|
Как легко сделать список своих файловногда бывает необходимо заполучить на лист Excel список файлов в заданной папке и ее подпапках. В моей практике такое встречалось неоднократно, например:перечислить в приложении к договору на проведение тренинга список файлов из раздаточных материалов для особо щепетильных юристов в некоторых компаниях создать список файлов для ТЗ проекта сравнить содержимое папок (оригинал и бэкап, например) Для реализации подобной задачи отлично подойдет небольшой макрос, добавляющий в текущую книгу новый пустой лист и выводящий на него список всех файлов с их параметрами из заданной пользователем папки вот такого, примерно, вида: Для добавления макроса в вашу книгу нажмите сочетание клавиш ALT+F11, в открывшемся окне редактора Visual Basic вставьте новый модуль через меню Insert - Module и скопируйте туда текст этого макроса: view plaincopy to clipboardprint? 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 Для запуска макроса нажмите сочетание клавиш ALT+F8, выберите наш макрос FileList и нажмите кнопку Выполнить (Run). В диалоговом окне выберите любую папку или диск и - вуаля! |
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Copyright Kulakoff © 2024 |
 |