Считывание имён файлов - Microsoft Office Excel

dobrohleb · 18.11.2008, 16:24

Всем здравствуйте!

Пожалуйста помогите! Нужно написать макрос, который бы считывал названия файлов и папок с диска.

Т.е. вставляешь диск в привод, запускаешь макрос и он тебе в Excell выдаёт список файлов и папок в столбец, содержащихся на диске, причем названия файлов уже в самих папках считывать не обязательно! Только в корневом каталоге. Ещё, если можно рядом в два столбика узнавать формат файлов и размер папок и самих файлов.

Жду Вашей помощи! Заранее СПАСИБО!!!

EducatedFool · 18.11.2008, 17:30

Запустите макрос CreateDirectoryListing

Вместо диска С в строке Set f = fso.GetFolder("c:\") поставьте букву нужного Вам диска.

(добавлено)
См. пример кода на сайте: http://excelvba.ru/code/FilenamesCollection

Код:

Sub CreateDirectoryListing()
    On Error Resume Next
    'Dim fso As FileSystemObject, f As Folder, fl As File, fld As Folder

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("c:\")

    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveWorkbook.Worksheets.Add
    ro = 2
    With sh
        .Cells(1, 1).Resize(1, 4).Interior.Color = vbGreen:
        .Cells(1, 1) = "Название папки": .Cells(1, 2) = "Тип":
        .Cells(1, 3) = "Дата создания": .Cells(1, 4) = "Размер папки":
        For Each fld In f.SubFolders
            .Cells(ro, 1) = fld.Name
            .Cells(ro, 2) = fld.Type
            .Cells(ro, 3) = fld.DateCreated
            .Cells(ro, 4) = FileOrFolderSize(fld.Size)
            ro = ro + 1: DoEvents
        Next
        ro = ro + 1
        .Cells(ro, 1) = "Название файла": .Cells(ro, 2) = "Тип файла":
        .Cells(ro, 3) = "Дата создания": .Cells(ro, 4) = "Размер файла"
        .Cells(ro, 1).Resize(1, 4).Interior.Color = vbMagenta: ro = ro + 1

        For Each fl In f.Files
            .Cells(ro, 1) = fl.Name
            .Cells(ro, 2) = fl.Type
            .Cells(ro, 3) = fl.DateCreated
            .Cells(ro, 4) = FileOrFolderSize(fl.Size)
            ro = ro + 1: DoEvents
        Next
        .Columns("a:e").AutoFit
        .UsedRange.HorizontalAlignment = xlCenter
        SetRangeBordersEx .UsedRange, xlContinuous, xlThin
    End With
    Application.ScreenUpdating = True
End Sub


Function FileOrFolderSize(ByVal s) As String
    Size = Fix(Val(s)): ' If s = "" Then FileOrFolderSize = "<нет доступа>"
    Select Case Size
        Case Is < 1000: FileOrFolderSize = Size & " байт"
        Case Is < 10000: FileOrFolderSize = FormatNumber(Size / 1024, 1) & " Кб"
        Case Is < 1000000: FileOrFolderSize = FormatNumber(Size \ 1024, 0) & " Кб"
        Case Is < 10000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 1) & " Mб"
        Case Is < 1000000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 0) & " Мб"
        Case Else: FileOrFolderSize = FormatNumber(Size / 1024 / 1024 / 1024, 1) & " Гб"
    End Select
End Function

Sub SetRangeBordersEx(ByRef ra As Range, ByVal BordersLineStyle As XlLineStyle, ByVal BordersWeight As XlBorderWeight)
    ra.Borders.LineStyle = BordersLineStyle
    ra.Borders.Weight = BordersWeight
    ra.Borders(xlDiagonalDown).LineStyle = xlNone
    ra.Borders(xlDiagonalUp).LineStyle = xlNone
End Sub

valerij · 18.11.2008, 18:45

Цитата:

Сообщение от EducatedFool

Запустите макрос CreateDirectoryListing

Да, Супер, Супер!!!

dobrohleb · 22.11.2008, 23:43

Ребята, СПАСИБО ОГРОМНОЕ! Честно, не ожидал с первого раза получить полный и достаточно чёткий ответ, но...

Всё СУПЕР! Даже менять под себя ничего не надо! СПАСИБО!!!

valerij · 01.12.2008, 20:23

EducatedFool!
А как сделать(никогда не думал, что с формами столкнусь, инфы практически, ноль), что бы при открытии книги, выдался запрос:
"Введите путь к папке", там ввожу к примеру: C:\Windows\winsxs и запускается макрос CreateDirectoryListing ?

EducatedFool · 01.12.2008, 21:00

Цитата:

что бы при открытии книги, выдался запрос:
"Введите путь к папке", там ввожу к примеру: C:\Windows\winsxs и запускается макрос CreateDirectoryListing ?

См. вложение:

valerij · 01.12.2008, 21:52

Цитата:

Сообщение от EducatedFool

См. вложение:

Да, СУПЕР!!!!!!

Вот и еще, одна, готовая прога!!

valerij · 28.03.2009, 00:31

Цитата:

Сообщение от EducatedFool

Код:

Function FileOrFolderSize(ByVal s) As String
    Size = Fix(Val(s)): ' If s = "" Then FileOrFolderSize = "<нет доступа>"
    Select Case Size
        Case Is < 1000: FileOrFolderSize = Size & " байт"
        Case Is < 10000: FileOrFolderSize = FormatNumber(Size / 1024, 1) & " Кб"
        Case Is < 1000000: FileOrFolderSize = FormatNumber(Size \ 1024, 0) & " Кб"
        Case Is < 10000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 1) & " Mб"
        Case Is < 1000000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 0) & " Мб"
        Case Else: FileOrFolderSize = FormatNumber(Size / 1024 / 1024 / 1024, 1) & " Гб"
    End Select
End Function

Как вывести общую сумму, размеров папок?
Может не в этом коде?

EducatedFool · 28.03.2009, 01:14

Валера, ну неужели сложно подсчитать сумму чисел?
Добавить-то надо было всего пару строк:

Код:

Sub CreateDirectoryListing()
    On Error Resume Next
    s = 0
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("c:\")

    Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = ActiveWorkbook.Worksheets.Add
    ro = 2
    With sh
        .Cells(1, 1).Resize(1, 4).Interior.Color = vbGreen:
        .Cells(1, 1) = "Название папки": .Cells(1, 2) = "Тип":
        .Cells(1, 3) = "Дата создания": .Cells(1, 4) = "Размер папки":
        For Each fld In f.SubFolders
            .Cells(ro, 1) = fld.Name
            .Cells(ro, 2) = fld.Type
            .Cells(ro, 3) = fld.DateCreated
            .Cells(ro, 4) = FileOrFolderSize(fld.Size)
            s = s + fld.Size
            ro = ro + 1: DoEvents
        Next
        ro = ro + 1
        .Cells(ro, 1) = "Название файла": .Cells(ro, 2) = "Тип файла":
        .Cells(ro, 3) = "Дата создания": .Cells(ro, 4) = "Размер файла"
        .Cells(ro, 1).Resize(1, 4).Interior.Color = vbMagenta: ro = ro + 1

        For Each fl In f.Files
            .Cells(ro, 1) = fl.Name
            .Cells(ro, 2) = fl.Type
            .Cells(ro, 3) = fl.DateCreated
            .Cells(ro, 4) = FileOrFolderSize(fl.Size)
            s = s + fl.Size
            ro = ro + 1: DoEvents
        Next

        ro = ro + 1
        .Cells(ro, 1) = "Суммарный объём:": .Cells(ro, 4) = FileOrFolderSize(s)
        .Cells(ro, 1).Resize(1, 4).Interior.Color = vbYellow

        .Columns("a:e").AutoFit
        .UsedRange.HorizontalAlignment = xlCenter
        SetRangeBordersEx .UsedRange, xlContinuous, xlThin
    End With
    Application.ScreenUpdating = True
End Sub

Function FileOrFolderSize(ByVal s) As String
    Size = Fix(Val(s)):
    Select Case Size
        Case Is < 1000: FileOrFolderSize = Size & " байт"
        Case Is < 10000: FileOrFolderSize = FormatNumber(Size / 1024, 1) & " Кб"
        Case Is < 1000000: FileOrFolderSize = FormatNumber(Size \ 1024, 0) & " Кб"
        Case Is < 10000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 1) & " Mб"
        Case Is < 1000000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 0) & " Мб"
        Case Else: FileOrFolderSize = FormatNumber(Size / 1024 / 1024 / 1024, 1) & " Гб"
    End Select
End Function

Sub SetRangeBordersEx(ByRef ra As Range, ByVal BordersLineStyle As XlLineStyle, ByVal BordersWeight As XlBorderWeight)
    ra.Borders.LineStyle = BordersLineStyle: ra.Borders.Weight = BordersWeight
    ra.Borders(xlDiagonalDown).LineStyle = xlNone: ra.Borders(xlDiagonalUp).LineStyle = xlNone
End Sub

Цитата:

Сообщение от valerij

И тут у тебя ошибка

Код:

Compile error:
Wrong number of arguments or invalid property assignment

Это у тебя ошибка.
Я проверяю код, прежде чем его выкладывать...
Вставь этот код в чистый файл, и проверь.

valerij · 28.03.2009, 01:21

Цитата:

Сообщение от EducatedFool

Добавить-то надо было всего пару строк

Да пытался...
И тут у тебя ошибка

Код:

Compile error:
Wrong number of arguments or invalid property assignment

18.11.2008, 16:24	#1
dobrohleb Пользователь Регистрация: 18.11.2008 Сообщений: 11	Считывание имён файлов Всем здравствуйте! Пожалуйста помогите! Нужно написать макрос, который бы считывал названия файлов и папок с диска. Т.е. вставляешь диск в привод, запускаешь макрос и он тебе в Excell выдаёт список файлов и папок в столбец, содержащихся на диске, причем названия файлов уже в самих папках считывать не обязательно! Только в корневом каталоге. Ещё, если можно рядом в два столбика узнавать формат файлов и размер папок и самих файлов. Жду Вашей помощи! Заранее СПАСИБО!!!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Нужна помощь: выбор файлов исходя из имени файлов	Antik163RUS	Помощь студентам	4	19.06.2008 21:20
Создание и считывание .ini файлов	Патрон	Общие вопросы Delphi	4	21.04.2008 03:25
Печать pdf файлов из списка файлов в Excel	АПС	Microsoft Office Excel	5	15.04.2008 16:04
Считывание пароля	Terran	Общие вопросы Delphi	1	22.03.2008 20:09
Считывание из файла	DimkinStd	Общие вопросы Delphi	7	24.01.2007 19:18

22.11.2008, 23:43	#4
dobrohleb Пользователь Регистрация: 18.11.2008 Сообщений: 11	Ребята, СПАСИБО ОГРОМНОЕ! Честно, не ожидал с первого раза получить полный и достаточно чёткий ответ, но... Всё СУПЕР! Даже менять под себя ничего не надо! СПАСИБО!!!

01.12.2008, 20:23	#5
valerij Старожил Регистрация: 12.05.2007 Сообщений: 2,339	EducatedFool! А как сделать(никогда не думал, что с формами столкнусь, инфы практически, ноль), что бы при открытии книги, выдался запрос: "Введите путь к папке", там ввожу к примеру: C:\Windows\winsxs и запускается макрос CreateDirectoryListing ?