Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.11.2008, 16:24   #1
dobrohleb
Пользователь
 
Регистрация: 18.11.2008
Сообщений: 11
Вопрос Считывание имён файлов

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

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

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

Жду Вашей помощи! Заранее СПАСИБО!!!
dobrohleb вне форума Ответить с цитированием
Старый 18.11.2008, 17:30   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Запустите макрос 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

Последний раз редактировалось EducatedFool; 18.04.2011 в 08:33.
EducatedFool вне форума Ответить с цитированием
Старый 18.11.2008, 18:45   #3
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
Запустите макрос CreateDirectoryListing
Да, Супер, Супер!!!
valerij вне форума Ответить с цитированием
Старый 22.11.2008, 23:43   #4
dobrohleb
Пользователь
 
Регистрация: 18.11.2008
Сообщений: 11
По умолчанию

Ребята, СПАСИБО ОГРОМНОЕ! Честно, не ожидал с первого раза получить полный и достаточно чёткий ответ, но... Всё СУПЕР! Даже менять под себя ничего не надо! СПАСИБО!!!
dobrohleb вне форума Ответить с цитированием
Старый 01.12.2008, 20:23   #5
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

EducatedFool!
А как сделать(никогда не думал, что с формами столкнусь, инфы практически, ноль), что бы при открытии книги, выдался запрос:
"Введите путь к папке", там ввожу к примеру: C:\Windows\winsxs и запускается макрос CreateDirectoryListing ?
valerij вне форума Ответить с цитированием
Старый 01.12.2008, 21:00   #6
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
что бы при открытии книги, выдался запрос:
"Введите путь к папке", там ввожу к примеру: C:\Windows\winsxs и запускается макрос CreateDirectoryListing ?
См. вложение:
Вложения
Тип файла: rar Просмотр содержимого папки.rar (14.0 Кб, 138 просмотров)
EducatedFool вне форума Ответить с цитированием
Старый 01.12.2008, 21:52   #7
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
См. вложение:
Да, СУПЕР!!!!!!

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

Последний раз редактировалось valerij; 01.12.2008 в 22:13.
valerij вне форума Ответить с цитированием
Старый 28.03.2009, 00:31   #8
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от 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
Как вывести общую сумму, размеров папок?
Может не в этом коде?

Последний раз редактировалось valerij; 28.03.2009 в 00:44.
valerij вне форума Ответить с цитированием
Старый 28.03.2009, 01:14   #9
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

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

Код:
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
Это у тебя ошибка.
Я проверяю код, прежде чем его выкладывать...
Вставь этот код в чистый файл, и проверь.

Последний раз редактировалось EducatedFool; 28.03.2009 в 01:26.
EducatedFool вне форума Ответить с цитированием
Старый 28.03.2009, 01:21   #10
valerij
Старожил
 
Аватар для valerij
 
Регистрация: 12.05.2007
Сообщений: 2,339
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
Добавить-то надо было всего пару строк
Да пытался...
И тут у тебя ошибка
Код:
Compile error:
Wrong number of arguments or invalid property assignment
valerij вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна помощь: выбор файлов исходя из имени файлов 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