Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как создать список подпапок заданной папки?
 
#1
28.12.2011 18:38:29
Подскажите пожалуйста,    
Есть папка "C:\Excel", как программно можно составить массив=array из её подпапок (подпапки подпапок не интересуют)?  
В дальнейшем предполагается применение получившегося списка в ListBox.
Работать надо не 12 часов, а головой.
 
 
 
#2
28.12.2011 18:44:40
это не пойдет? http://excelvba.ru/code/FoldersList
 
 
 
#3
28.12.2011 18:46:34
Скорее всего, не совсем то, что вы искали, но можно сделать примерно так:  
В консоли Windows (пуск-выполнить - сmd)  
зайти в нужную папку при помощи команды cd c:\excel  
написать команду dir /s  >1.xls  
она составит файл с названием 1.xls с содержимым каталога.  
При открытии файла ексель ругрется, что файл некорректен, но все равно его откроет.
 
 
 
#4
28.12.2011 18:50:16
вот еще http://excelvba.ru/code/FilenamesCollection
 
 
 
#5
28.12.2011 19:34:02
FoldersList сократила и всё подошло. Спасибо!  
 
{quote}{login=}{date=28.12.2011 06:50}{thema=}{post}вот еще http://excelvba.ru/code/FilenamesCollection{/post}{/quote}  
FilenamesCollection это должен был быть мой следующий вопрос:)  
 
Вырезала всё необходимое. Не работает. Подскажите пожалуйста, где осеклась?  
 
Sub File_DoIt()  
Mask = ".xls"  
FolderPath = "D:\Diz.Diz\Zet\Ðàáî÷èé ñòîë\TEMP\"  
     
  On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)  
   If Not curfold Is Nothing Then  
 
       For Each fil In curfold.Files  
       i = i + 1  
        If fil.Name Like "*" & Mask Then Range("B" & 2 + i) = fil.Name  
        D = fil.Name  
       Next  
       Set fil = Nothing: Set curfold = Nothing  
  End If  
 
End Sub
Работать надо не 12 часов, а головой.
 
 
 
#6
28.12.2011 20:03:20
Спасибо большое! Всё получилось.
Работать надо не 12 часов, а головой.
 
 
 
#7
27.04.2012 01:33:50
FoldersList  (http://excelvba.ru/code/FoldersLis) очень хорошо но мне нужно чтобы он также мог выводить 3 и более уровней.  
   
Если можно то сделать строчку куда можно вставлять число уровне, если это долго и проблематично, тогда подскажите что куда дописывать?
 
 
 
#8
27.04.2012 11:34:48
Сюда загляните:  http://excelvba.ru/code/FilenamesList
 
 
 
#9
04.11.2012 15:53:30
необходимо сделать 3 листбокса, т.о, чтобы в 1м были значения 1го уровня, во 2м - значения 2го уровня соответствующего значения из 1го листбокса (после выбора значения 1го уровня) и тд  
 
т.е. если я выбираю в первом листбоксе 3е значение, то во втором листбоксе отображаются только 3.1, 3.2 и тд.    
после выбора 3.2, в третьем листбоксе отобразятся только 3.2.1 и 3.2.2.    
 
проблема в том, что значения для листбокса 2го уровня раскиданы по строкам, а не идут подряд и для обозначения конца массива для 2го уровня необходимо определить конец 3го значения в 1м уровне.  
собственно, проблема в процедуре ListBox1_AfterUpdate(). остальное работает как надо  
 
Private Sub UserForm_Initialize()  
   Dim Client() As Variant  
   Dim Clients_Num As Integer  
     
   Clients_Last_Row = Sheets("Çàêàç÷èêè").Range("d999").End(xlUp).Row  
   Clients_Num = Count_nonblank(Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row))  
   ReDim Client(1 To Clients_Num)  
   For i = 2 To Clients_Last_Row  
       If Sheets("Çàêàç÷èêè").Cells(i, 4).Value <> Empty Then  
          j = j + 1  
          Client(j) = Sheets("Çàêàç÷èêè").Cells(i, 4).Value  
          ListBox1.AddItem (Client(j))  
       End If  
   Next i  
         
   j = Empty  
 
End Sub  
 
Private Sub ListBox1_AfterUpdate()  
             
   ListBox2.Clear  
   ListBox3.Clear  
     
   Choosen_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Value).Row  
   Next_Index = ListBox1.TabIndex + 2  
'    Next_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Selected(Next_Index).Value).Row  
   Choosen_Client_Subdivisions_Count = Count_nonblank(Sheets("Çàêàç÷èêè").Range(Cells(Choosen_Client + 1, 5), Cells(Next_Client - 1, 5)))  
'    Choosen_Client_Subdivisions_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).Value <> Empty Then  
       For i = Choosen_Client + 1 To Choosen_Client_Subdivisions_Count  
           ListBox2.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 5))  
       Next i  
   End If  
End Sub  
 
Private Sub ListBox2_AfterUpdate()  
             
   ListBox3.Clear  
     
   Choosen_Subdivision = Sheets("Çàêàç÷èêè").Range("e2:e" & Clients_Last_Row).Find(ListBox2.Value).Row  
   Choosen_Subdivision_Services_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).Value <> Empty Then  
       For i = Choosen_Subdivision + 1 To Choosen_Subdivision_Services_Count  
           ListBox3.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 6))  
       Next i  
   End If  
End Sub  
 
 
Function Count_nonblank(x As Range) As Integer  
   Count_nonblank = x.Cells.Count - WorksheetFunction.CountBlank(x)  
End Function
 
 
 
Страницы: 1
Читают тему
Наверх