v prilozenem souboru si muzete zkusit, jak ziskat podadresare a soubory ze zadane slozky (napsat do bunky C1 (musi koncit zpetnym lomitkem)).
Příloha: 
5407_sesit2.zip (12kB, staženo 580x)
citovat5407_sesit2.zip (12kB, staženo 580x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Výpis obsahu složek
MS Excel
Téma: Výpis obsahu složek 
Zaslal/a Kadel 30.6.2011 12:44
Dobrý den.
Potřeboval bych přes Excel udělat výpis souborů a složek z adresáře (např. vše z C:\\Zakázky\). To by se vypsalo do sloupce A postupně pod sebe. Já bych si ručně ke každému vypsanému řádku do dalších sloupců přidal různé tagy (př. sloupec B -> moře; sl. C -> dovolená, sl. D -> 2010 atd.). Zároveň bych ale chtěl, aby se to při každém otevření aktualizovalo, doplnily se nové soubory, ale stávající by zůstaly vč. těch tagů. Potřebuji totiž mít rychle přehled o souborech, které obsahují určitý tag (př. všechny fotografie obsahující tag moře - filtrování). Nebo pokud znáte nějaký program, tak určitě doporučte. Děkuji.
Příloha: 5406_sesit2.rar (7kB, staženo 89x)
5406_sesit2.rar (7kB, staženo 89x)Super, díky. Šlo by to ještě udělat tak, aby to projelo i podsložky? Teďka mi to napíše cestu a název složky, ale do ní už to nevleze.citovat
tady to je, ale umi to jen dve urovne - dal se mi to delat nechce...
Příloha: 5411_sesit2.zip (12kB, staženo 516x)
citovat5411_sesit2.zip (12kB, staženo 516x)Sice to není původně z mé hlavy, ale upravil jsem si to a běžně to používám :-)
Sub List_All_The_Files_Within_Path()
Application.ScreenUpdating = False
Dim radek As Integer
Dim No_Of_Files As Integer
Dim kk25 As Integer
Dim File_Path As String
File_Path = "D:\Pokus"
radek = 2
With Application.FileSearch
.NewSearch
.LookIn = File_Path
.Filename = "*.*"
.SearchSubFolders = True
.Execute
No_Of_Files = .FoundFiles.Count
For kk25 = 1 To No_Of_Files
Cells(radek, 2).Value = Dir(.FoundFiles(kk25))
Cells(radek, 3).Value = .FoundFiles(kk25)
Cells(radek, 1).Value = Left(Cells(radek, 3), Len(Cells(radek, 3)) - Len(Cells(radek, 2)))
radek = radek + 1
Next kk25
End With
Cells(1, 1) = "Adresář"
Cells(1, 2) = "Soubor"
Cells(1, 3) = "Celá cesta"
Columns("A:C").EntireColumn.AutoFit
Range("A1:C1").Interior.Color = vbYellow
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
End Sub
M@citovat
Sub List_All_The_Files_Within_Path()
Application.ScreenUpdating = False
Dim radek As Integer
Dim No_Of_Files As Integer
Dim kk25 As Integer
Dim File_Path As String
File_Path = "D:\Pokus"
radek = 2
With Application.FileSearch
.NewSearch
.LookIn = File_Path
.Filename = "*.*"
.SearchSubFolders = True
.Execute
No_Of_Files = .FoundFiles.Count
For kk25 = 1 To No_Of_Files
Cells(radek, 2).Value = Dir(.FoundFiles(kk25))
Cells(radek, 3).Value = .FoundFiles(kk25)
Cells(radek, 1).Value = Left(Cells(radek, 3), Len(Cells(radek, 3)) - Len(Cells(radek, 2)))
radek = radek + 1
Next kk25
End With
Cells(1, 1) = "Adresář"
Cells(1, 2) = "Soubor"
Cells(1, 3) = "Celá cesta"
Columns("A:C").EntireColumn.AutoFit
Range("A1:C1").Interior.Color = vbYellow
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
End Sub
M@citovat
Bohužel mi to druhé řešení udává chybu - With Application.FileSearch - a pokud to odkrokuji tak o řádek výše - radek = 2 - to ukazuje 0.citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články