Вопрос № 149526: Здравствуйте уважаемые эксперты!!! Мне нужно решить следующую задачу: в Excel 2003 на листе, при нажатии кнопки, должно открываться окно с выбором папки, и при выборе папки, на листе Excel должны записаться файлы из этой папки и подпапок. В Ин...
Вопрос № 149.526
Здравствуйте уважаемые эксперты!!! Мне нужно решить следующую задачу: в Excel 2003 на листе, при нажатии кнопки, должно открываться окно с выбором папки, и при выборе папки, на листе Excel должны записаться файлы из этой папки и подпапок. В Интернете нашел файл (см. приложение), который наполовину решает мою проблему, но там используется три кнопки, и файлы отображаются только из папки, а мне надо, чтобы и из подпапок тоже отображались файлы. В VBA я не силен, сам такое решить не могу
Приложение:
Отправлен: 05.11.2008, 10:53
Вопрос задал: Nickem2004 (статус: 4-й класс)
Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)
Отвечает: Шичко Игорь
Здравствуйте, Nickem2004! Предлагаю Вам несколько доработанный код для Вашей задачи. 1. В редакторе VBA измените процедуру Private Sub Cmd_Путь_Click() 2. Добавьте Sub FileListing_New(MyPath As String, NameListRange As String) Коды в приложении. Теперь по нажатию кнопки "Путь" и выбора папки отображаются и файлы из подкаталогов. Если все устроит, то можете удалить процедуру Sub FileListing(MyPath As String, NameListRange As String) (которая была раньше)
Приложение:
Ответ отправил: Шичко Игорь (статус: Студент)
Ответ отправлен: 05.11.2008, 12:39
Как сказать этому эксперту "спасибо"?
Отправить SMS
#thank 234439 на номер 1151 (Россия) | Еще номера >>
Вам помогли? Пожалуйста, поблагодарите эксперта за это!
Оценка за ответ: 5 Комментарий оценки: Спасибо, то что нужно. Единственное, если указать например диск D, то перебираются все файлы из папок и подпапок этого диска, это занимает время. Но мне в основном не нужно работать с дисками, только с конкретными папками. Спасибо.
Отвечает: Тесленко Евгений Алексеевич
Здравствуйте, Nickem2004! Предлагаю Вам вариант рекурсивного "осмотра" папок
Код:
Private Sub Cmd_Папки_Click() Dim temp$ temp = browse_folder If Not Len(temp) = 0 Then Range("mas_List").ClearContents: FolderListing temp, "mas_List", 0 End
Sub Sub FileListing(MyPath$, NameListRange$, m&) Dim fso As FileSystemObject, f As Folder, fc As Files, fl As File, iL# Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(MyPath) Set fc = f.Files For Each fl In fc m = m + 1 With Range(NameListRange) .Cells(m, 1).Value = m .Cells(m, 2).Value = fl.Name iL = fl.Size If iL / 1024 = iL 1024 Then iL = iL / 1024 Else
iL = iL 1024 + 1 .Cells(m, 3).Value = iL & " КБ" .Cells(m, 4).Value = fl.Type .Cells(m, 5).Value = fl.DateLastModified End With Next End Sub Sub FolderListing(MyPath$, NameListRange$, m&) Dim fso As FileSystemObject, f As Folder, sf As Folder Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(MyPath) FileListing MyPath, NameListRange, m For Each sf In f.SubFolders m = m + 1 With Range(NameListRange)
.Cells(m, 1).Value = m '.Cells(m, 2).Value = sf.Name .Cells(m, 2).Value = sf.Path .Cells(m, 4).Value = sf.Type .Cells(m, 5).Value = sf.DateLastModified End With FolderListing MyPath & "" & sf.Name, NameListRange, m Next End Sub
* Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи.
(полный список тарифов)
** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
*** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.
