Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Создание списка файлов, хранящихся на диске
 
#1
30.10.2008 16:00:04
Коллеги, добрый вечер!  
 
С ростом количества файлов, хранящихся на диске, возникла следующая задачка:  
 
Есть ли возможность написать макрос, который будет просматривать все папки, хранящиеся на диске(включая подпапки) , выцеплять оттуда имена файлов вместе с расширениями и вставлять на лист excel в качестве гиперлинков?    
 
Если есть какие-либо соображения по этому поводу - отпишитесь пожадуйста!  
 
Заранее спасибо!
 
 
 
#2
30.10.2008 16:06:18
Dim MyFile, MyPath, MyName  
MyFile = Dir("С:\лалала\")  
для получения следующего имени файла  
MyFile = Dir  
 
а вот по поддиректориям я не лазил, может кто другой знает.
 
 
 
#3
30.10.2008 16:17:37
{quote}{login=Марчук}{date=30.10.2008 04:06}{thema=}{post}Dim MyFile, MyPath, MyName  
MyFile = Dir("С:\лалала\")  
для получения следующего имени файла  
MyFile = Dir  
 
а вот по поддиректориям я не лазил, может кто другой знает.{/post}{/quote}
 
 
 
#4
30.10.2008 16:18:44
Так вот в этом-то и проблема... Директории нужно как-то учесть...  
 
Помогите)))
 
 
 
#5
30.10.2008 16:49:32
Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
                              TextToDisplay:=.FoundFiles(i)  
Next  
End With  
End Sub
 
 
 
#6
05.11.2008 13:13:17
{quote}{login=Prog}{date=30.10.2008 04:49}{thema=}{post}Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
                              TextToDisplay:=.FoundFiles(i)  
Next  
End With  
End Sub{/post}{/quote}  
 
СПАСИБО!!!  
РАБОТАЕТ!  
 
Как вы думаете, если пойти далее - есть возможность представления полученной информации более удобно для восприятия? Например, в виде дерева или списка?
 
 
 
#7
05.11.2008 13:23:08
мм,  
ну можно анализировать .foundfiles(i) перед    
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
TextToDisplay:=.FoundFiles(i)  
 
и придумать какую-нибудь логику тут.
 
 
 
#8
05.11.2008 13:30:39
а тот список, что предоставляет ОС, чем не устраивает?
Живи и дай жить..
 
 
 
#9
05.11.2008 16:55:15
вот такой есь упрощённый вариант, но можно переделать всё под себя...
 
 
 
#10
14.12.2009 13:30:22
{quote}{login=Prog}{date=30.10.2008 04:49}{thema=}{post}Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
                              TextToDisplay:=.FoundFiles(i)  
Next  
End With  
End Sub{/post}{/quote}  
У меня этот макрос в 2007 не работает, что я делаю не так?
 
 
 
#11
14.12.2009 14:43:13
{quote}{login=}{date=14.12.2009 13:30}{thema=}{post}У меня этот макрос в 2007 не работает, что я делаю не так?{/post}{/quote}  
Что никто не знает?
 
 
 
#12
14.12.2009 14:55:05
Спасибо за ответ. А альтернатива методу FileSearch в 2007-ом имеется? Или не стоит и пытаться и лучше к 2003-му обратиться?
 
 
 
#13
14.12.2009 14:55:10
{quote}{login=The_Prist}{date=14.12.2009 02:46}{thema=}{post}Я знаю. В 2007 Офисе метод FileSearch отсутствует. Разработчики сочли его лишним. В смысле он где-то есть, но он не может использоваться.  
 
P.S.Даже если Вы напишите ОЧЕНЬ-ОЧЕНЬ срочно, ничего от этого не измениться.{/post}{/quote}  
 
Еще один косяк от 2007... Пока минусов больше чем плюсов (для Лузера).
 
 
 
#14
14.12.2009 15:13:13
{quote}{login=Prog}{date=30.10.2008 04:49}{thema=}{post}Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
                              TextToDisplay:=.FoundFiles(i)  
Next  
End With  
End Sub{/post}{/quote}  
Ни как не въеду- как сделать чтобы макрос выдавал список только из фалов с определенным расширением например ".xls".  
Подскажите пожалуйста.  
Спасибо
 
 
 
#15
14.12.2009 15:21:33
{quote}{login=The_Prist}{date=14.12.2009 03:17}{thema=Re: Re: }{post}{quote}{login=Alexander_V}{date=14.12.2009 03:13}{thema=Re: }{post}Ни как не въеду- как сделать чтобы макрос выдавал список только из фалов с определенным расширением например ".xls".{/post}{/quote}  
sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.xls"){/post}{/quote}  
Уважаемый The_Prist, а в коде куда втавить?
 
 
 
#16
14.12.2009 15:21:37
{quote}{login=The_Prist}{date=14.12.2009 03:08}{thema=}{post}Вот Вам через FSO(он мне наиболее симпатичен, т.к. не может вызвать перегруза памяти в отличии от рекурсии)  
 
Sub Get_FileName_InSubFolders_FSO()  
   Dim sName As String, oFSO As Object, oItem As Object, li As Long  
   Set oFSO = CreateObject("Scripting.FileSystemObject")  
   For Each oItem In oFSO.GetFolder(ThisWorkbook.Path).SubFolders  
       sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
       Do While sName <> ""  
           li = li + 1: Cells(li, 1) = sName  
           sName = Dir  
       Loop  
   Next  
End Sub  
 
Вместо  
sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
задайте свой путь и маску файлов или получайте их через диалоговое окно.{/post}{/quote}  
The_Prist, спасибо за макрос. Будем пробовать.
 
 
 
#17
14.12.2009 15:25:53
{quote}{login=}{date=14.12.2009 03:21}{thema=Re: }{post}{quote}{login=The_Prist}{date=14.12.2009 03:08}{thema=}{post}Вот Вам через FSO(он мне наиболее симпатичен, т.к. не может вызвать перегруза памяти в отличии от рекурсии)  
 
Sub Get_FileName_InSubFolders_FSO()  
   Dim sName As String, oFSO As Object, oItem As Object, li As Long  
   Set oFSO = CreateObject("Scripting.FileSystemObject")  
   For Each oItem In oFSO.GetFolder(ThisWorkbook.Path).SubFolders  
       sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
       Do While sName <> ""  
           li = li + 1: Cells(li, 1) = sName  
           sName = Dir  
       Loop  
   Next  
End Sub  
 
Вместо  
sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
задайте свой путь и маску файлов или получайте их через диалоговое окно.{/post}{/quote}  
The_Prist, спасибо за макрос. Будем пробовать.{/post}{/quote}  
У меня этот код никак не действует.
 
 
 
#18
14.12.2009 15:38:56
Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=.FoundFiles(i), _  
TextToDisplay:=.FoundFiles(i)  
Next  
End With  
End Sub  
 
Он у меня отлично идет но выдает список из всех файлов, а мне нужно его подправить, что бы выдавал с определенным разрешением, к примеру .xls .
 
 
 
#19
14.12.2009 15:49:30
{quote}{login=The_Prist}{date=14.12.2009 03:43}{thema=}{post}Мне трудно проверить, т.к. не имею 2003. Наверное так  
 
Sub qq()  
With Application.FileSearch  
.LookIn = "C:\"  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
if .FoundFiles(i) Like "*.xls" then  
li = li + 1  
ActiveSheet.Hyperlinks.Add Anchor:=Cells(li, "A"), Address:=.FoundFiles(i), _  
TextToDisplay:=.FoundFiles(i)  
end if  
Next  
End With  
End Sub{/post}{/quote}  
Все круто!!! То что надо.  
The_Prist, Большое спасибо.
 
 
 
#20
09.09.2011 11:35:10
{quote}{login=The_Prist}{date=14.12.2009 03:08}{thema=}{post}Вот Вам через FSO(он мне наиболее симпатичен, т.к. не может вызвать перегруза памяти в отличии от рекурсии)  
 
Sub Get_FileName_InSubFolders_FSO()  
   Dim sName As String, oFSO As Object, oItem As Object, li As Long  
   Set oFSO = CreateObject("Scripting.FileSystemObject")  
   For Each oItem In oFSO.GetFolder(ThisWorkbook.Path).SubFolders  
       sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
       Do While sName <> ""  
           li = li + 1: Cells(li, 1) = sName  
           sName = Dir  
       Loop  
   Next  
End Sub  
 
Вместо  
sName = Dir(ThisWorkbook.Path & "\" & oItem.Name & "\" & "*.*")  
задайте свой путь и маску файлов или получайте их через диалоговое окно.{/post}{/quote} Файл с этим макросом находится на рабочем столе. Здесь же имеются другие файлы и папки. Так вот в списке, сформированном макросом, отсутствуют файлы с рабочего стола, но выведены файлы находящиеся в других папках на РС. Что надо подправить, чтобы выводился список файлов именно из той директории, где находится файл с макросом?  
Спасибо.
 
 
 
#21
09.09.2011 11:58:39
Исправить всего одну строку:  
Sub qq()  
With Application.FileSearch  
.LookIn = ThisWorkbook.Path 'Вот эту  
.FileType = msoFileTypeAllFiles  
.SearchSubFolders = True  
.Execute  
For i = 1 To .FoundFiles.Count  
If .FoundFiles(i) Like "*.xls" Then  
li = li + 1  
ActiveSheet.Hyperlinks.Add Anchor:=Cells(li, "A"), Address:=.FoundFiles(i), _  
TextToDisplay:=.FoundFiles(i)  
End If  
Next
 
 
 
#22
09.09.2011 13:14:17
Юрий М, у меня Ваш макрос не сработал. Эксель 2010.
 
 
 
#23
09.09.2011 13:17:18
Вы же не говорили, что у Вас 2010 - в нём убрали .FileSearch
 
 
 
#24
09.09.2011 13:23:34
Если кто-то не умеет пользоваться Яндексом - напомню ссылку на готовое решение для поиска файлов, и вывода их списка на лист: http://excelvba.ru/code/FilenamesCollection
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#25
09.09.2011 13:23:57
Зачем изобретать велосипед, поставь asap utilites (см. Ссылки)
O Tempora, O Mores!!!
 
 
 
#26
09.09.2011 13:24:52
{quote}{login=Юрий М}{date=09.09.2011 01:17}{thema=}{post}Вы же не говорили, что у Вас 2010 - в нём убрали .FileSearch{/post}{/quote} Нет, не говорил, но я изначально спросил про макрос не с FileSearch, а с FSO от The_Prist. FSO в 2010 работает, правда надо подправить, под мои нужды и не знаю как.
 
 
 
#27
09.09.2011 13:31:27
Вот у меня что-то подобное нашлось...
 
 
 
#28
09.09.2011 13:35:14
Спасибо всем, и отдельно за post_258025.xls.
 
 
 
#29
09.09.2011 13:54:51
Писалось еще под офис 98. И в 2010 работает:-)  
 
30505
Я сам - дурнее всякого примера! ...
 
 
 
#30
09.09.2011 13:57:30
Соврал. Офис 7.
Я сам - дурнее всякого примера! ...
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх
Loading...