Office Guru

Kapóra jön máshol: könyvtártartalom listázása egy rövidke kódszelet segítségével

2016. március 13. - Office Guru

Kihasználva a hétvégét, tovább folytatom elmaradásom feldolgozását, már ami az olvasói kérdéseket illeti és ezúttal egy nagyobb fába vágom a fejszémet, mert az Excel-kérdések egyikének megválaszolása nem is egy posztot fel felölelni, hiszen én több részre osztottam a megoldást - a kérdés önállóan is kezelhető első része egyébként a kedves írónak nem okozott gondot, de hátha másnak is szüksége lehet ilyesmire, így kezdjük ezzel a kifejtést.

Szóval a kérdés ezen része olyasmi, amelyre nem VBA-s megoldást már kínáltam korábbi posztokban (például a command promptból indítható dir parancs vagy a böngészős Select All Content segítségével), de most azt nézzük meg, hogy makróval hogy tudjuk kilistázni egy adott könyvtárunk tartalmát. Célunk tehát ennek a kis táblának az automatikus kitöltése:

sss01.jpgAhogy mindig, most is hangsúlyozni kell, hogy ez csak egy a lehetséges megoldások közül, szóval továbbra is nyitott vagyok más javaslatokra/ötletekre.

Rövid VBA-kódunk magját és legfontosabb elemét a FileSystemObject objektum adja, amely objektumalapú lehetőséget ad számunkra, hogy hozzáférjünk a számítógépünk fájlrendszeréhez. Egyszerűen csak létre kell hoznunk egy FileSystemObject objektumot VBA-ban a Scripting.FileSystemObject szintaxis segítségével, aztán már törölhetünk, beolvashatunk vagy akár létre is hozhatunk fájlokat. Hogy értsük a szintaxist, érdemes megjegyezni, hogy a FileSystemObject a Microsoft Scripting Runtime Libraryben található dll-ként.

Visszatérve a mostani kérdéskörhöz, lépjünk be a Visual Basic Editorba, majd hozzunk létre négy változót, hármat objektumként, egyet pedig integer típussal:

sss02.jpgFSO a fentebb már említett FileSystemObject objektum, amelyet azért hozunk mindjárt létre, hogy hozzáférjünk a fájlrendszerhez, a Folder és File változók értelemszerűen könyvtár és fájl objektumok tárolására szolgálnak majd, i változónkra pedig a ciklushoz lesz majd szükségünk.

Ha megvannak a változók, akkor állítsuk be, hozzuk létre a FileSystemObject objektumot:

Set FSO = CreateObject("Scripting.FileSystemObject")

Majd a Folder objektumot is állítsuk be arra a könyvtárra, ahol listázni akarunk, ehhez a FileSystemObject objektum GetFolder metódusát használjuk, amely mindig objektumként adja vissza nekünk azt a foldert, amely a megadott elérési úton található:

Set Folder = FSO.GetFolder("c:\")

sss03.jpgEzzel konkrétan már a folderben vagyunk, most jön a ciklusunk, amely egyesével végigmegy a folderben lévő fájlokon és azok nevét egymást követő cellákba írja be.

Miután van fejlécünk, kezdjük alapból az i = 1 értékkel, de mint látni fogjuk ez lehetne 0 de akár 2 is, attól függően hova akarjuk tenni az értéklistát.

A ciklushoz a már jópár alkalommal bemutatott és megismert For Each...Next utasítást fogjuk felhasználni, azaz ha magyarra átfordítva fogalmazzuk meg a kódunkat, akkor minden egyes fájlunk esetén (For Each File) a fentebb definiált folderünk összes fájlja között (in Folder.files), fájlonként haladva az első oszlopunk második cellája (Cells(i + 1, 2)) legyen egyenlő a fájl nevével (File.Name), a második oszlopunk második cellája (Cells(i + 1,2)) pedig legyen egyenlő a fájl elérési útjával (File.Path). Ha ez megvan, akkor ugorjon a következő sorra, azaz i értékét növeljük meg eggyel (i = i + 1).

i = 1
For Each File In Folder.files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File

sss04.jpgVegyük észre, hogy File objektumunknak minden tulajdonságához hozzáférünk, így a nevéhez, elérési útjához is, de ezen analógia mentén férünk hozzá a létrehozási dátumához, utolsó megnyitási időpontjához vagy akár méretéhez is.

Ha ez megvan, akkor meg is van a kódunk, innentől kezdve pedig gombhoz rendelhetjük, vagy ahogy majd én is tenni fogom, egy nagyobb kód első részeként fogjuk felhasználni.

sss05.jpg

 

Kódunk szövegként:

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("c:\")
i = 1
For Each File In Folder.files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File
End Sub

A bejegyzés trackback címe:

https://officeguru.blog.hu/api/trackback/id/tr508474048

Kommentek:

A hozzászólások a vonatkozó jogszabályok  értelmében felhasználói tartalomnak minősülnek, értük a szolgáltatás technikai  üzemeltetője semmilyen felelősséget nem vállal, azokat nem ellenőrzi. Kifogás esetén forduljon a blog szerkesztőjéhez. Részletek a  Felhasználási feltételekben és az adatvédelmi tájékoztatóban.

Bacsi Kornél 2020.01.10. 18:16:52

Szia

Kérdésem az lenne, hogy tudom elérni, hogy egy adott mappa almappáinak tartalmát listázza?
Nagyon amatőr vagyok a makro területén, és nagy segítség lenne számomra lényegében meg oldottam, csak sokkal bonyolultabban. Ez a kód jó lenne viszont csak egy adott mappát listáz.

A segítséget előre is köszönöm.

2020.01.17. 07:12:55

@Bacsi Kornél: esetleg egy másik irányból egyszerűbb megközelíteni (nem tudom mire kell ez Neked) :
- a Shell függvénnyel meghívni egy küldő parancsot (dir), ami előállítja egy fájlba a kívánt listát egy fájlba írva
- aztán ezt a fájlt betölteni excelbe

Bacsi Kornél 2020.01.18. 09:53:34

Szia
A linkeket amiket küldtél, köszönöm. Átnézem őket, a Shell fügvénnyel nem biztos, hogy boldogulok.
Nagyon amatör vagyok a makró terén. Kevéske angol tudással fűszerezve :)
Lényegében amit szeretnék elérni:
Van egy exel táblázatom, amiben A3 cellából lefelé ismeretlen mennyiségű sorszámot írok, napi szinten. Általában évente 4-5 ezer közé és esik.
Ezek papír alapú munkaigénylők, amiket scannelek is.
A scannelt lapok egy külön mappában találhatók, amik minden évre külön mappát a mappán belül külön hónap mappákat tartalmaznak. A pdf fájlok ugyan azt a nevet kapják mint ami a sorszámuk.
Ezekből szeretném az exel táblázat AH3 cellájából lefelé haladva kilistázni az adott év mappájából és havi almappákból a pdf fájlok nevét.
Amit átnevezek az exelben.(a pdf. fájlnevet "leszedem" róluk) és egy keres függvénnyel nevük alapján ellenőrzöm, hogy scannelve van e a papír.
Ez lenne a listázási szakasz.
És a táblázat B3 celláiba a sorszámhoz tartozó pdf fájlt is be szeretném hivatkozni.
Ez is megy , de szintén csak az első hónapig.

Bacsi Kornél 2020.01.18. 10:10:19

Lényegében ez a képlet az ami az adott mappát ki listázza.

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("c:\")
i = 1
For Each File In Folder.files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File
End Sub

Amit küldtél abban van egy javaslat:

' treelist.vbs
'
' Az aktualis mappat es az almappait kilistazza ltree.txt-be.
'
' Kiraly Tibor
' 2007-06-10

Dim oFSO, oFolder, listafile, filenev
Set oFSO= CreateObject( "Scripting.FileSystemObject")
filenev= "ltree.txt" ' lista file neve
Set oFolder= oFSO.GetFolder( ".") ' aktualis mappa beolvasasa

filenev= oFolder.Path& "\"& filenev ' lista file letrehozasa
Set listafile= oFSO.CreateTextFile( filenev)
Set listafile= Nothing

' mappak kilistazasa
Set listafile= oFSO.OpenTextFile( filenev, 2) ' file megnyitasa irasra
listafile.WriteLine( oFolder.Path) ' gyoker mappa kiirasa
almappa_kiiro( oFolder) ' almappak kiirasa
listafile.Close ' file lezarasa
'End of Script

Function almappa_kiiro( oMappa) ' almappakat kilistazo rekurziv fgv.
For Each oAlmappa in oMappa.SubFolders ' az oMappa-bol az osszes oAlmappa-an vegigmegy
listafile.WriteLine( oAlmappa.Path) ' kiirja az oAlmappa eleresi utjat
almappa_kiiro( oAlmappa) ' megnezi van-e almappaja - rekurzio
Next
End Function

És ebből ollóztam össze ezt.

Sub list()
Dim oFSO As Object
Dim oFolder As Object
Dim File As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("D:\Users\kornel_bacsi\Desktop\Új kaizen összesítő\Kaizen ig. fotók 2019")
i = 2
For Each File In oFolder.Files
Cells(i + 1, 34) = File.Name
i = i + 1
Next File
End Sub

Futtatáskor nem dob fel hibát, de nem is történik semmi.

Sajnos itt megállt a tudományom.

2020.01.18. 23:10:26

@Bacsi Kornél: de működik a Tied, csak a 34.oszlopba írja a fájl nevét!

írd át: Cells(i + 1, 1) = File.Name -re

amúgy ezt kb. is megcsinálja:
Sub dirtofile()
Dim i
i = Shell(pathname:="cmd.exe /k dir /b d:\Temp\2020\01 > d:\temp\2020\01list.txt", windowstyle:=vbHide)
Workbooks.Open ("d:\temp\2020\01list.txt")
End Sub
ez kilistáz egy adott alkönyvtárat (pld. nálad 1 hónapot) és beolvassa excelbe

2020.01.18. 23:25:57

de csináld így és így kilistázza az alkönyvtárakat is:
az msgbox azért kell, mert a shell még nem fut le, mire már nyitná a fájlt az excel :)

Sub dirtofile()
Dim i
i = Shell(pathname:="cmd.exe /k dir /b/s d:\Temp\2020 > d:\temp\list.txt", windowstyle:=vbHide)
MsgBox "listázva"
Workbooks.Open ("d:\temp\list.txt")
End Sub

azt/úgy sem vészes megírni, ahogy Te írtad, de ha azzal a listázóval csinálod a fájlnév listát, akkor kell a rekurziv rész is ami az alkönyvátrokba belemegy

2020.01.19. 20:52:38

mivel Neked nem kell a rekurcziv listázás (tekintve, hogy tudod milyen mappák lesznek, legegyszerűbb így használnod:

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i, ho, c As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 1
ho = Month(Now) 'melyik hónap van

For c = 1 To ho
Set Folder = FSO.GetFolder("d:\temp\2020\" & Format(c, "00"))
For Each File In Folder.Files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
i = i + 1
Next File
Next c
End Sub

Bacsi Kornél 2020.01.21. 01:50:31

Köszönöm a segítség megoldódott a problémám a listázással kapcsolatban.
A hivatkozással kapcsolatban kérhetek még segítséget?

Jelenleg ezzel a képlettel hivatkozom be pdf. fájlokat.

Sub hivatkozás()
Dim sPath As String, Value As String, cl As Range, usor As Integer, StartCell As Range
Dim WS As Worksheet

Set WS = Sheets("Kaizen összesítő") 'ide teszi a hivatkozást
sPath = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.01\"
Set StartCell = WS.Range("B3")
usor = WS.Range("B" & Rows.Count).End(xlUp).Row
For Each cl In WS.Range("B3:B" & usor)
cl.Hyperlinks.Delete
If Not IsEmpty(cl) Then
Value = Dir(sPath & cl.Value & ".pdf")
If Value <> "" Then
StartCell.Hyperlinks.Add Anchor:=StartCell, Address:= _
sPath & Value, TextToDisplay:=cl.Value
End If
End If
Set StartCell = StartCell.Offset(1, 0) ' a következő cella cime
Next
End Sub

Ebben az esetben mit kell módosítanom, hogy almappákból hivatkozzon?
Mindent a netről gyűjtögettem, és arról sajnos még keveset tudok, hogy mi mit jelent a képletben.

2020.01.21. 10:21:55

@Bacsi Kornél: hát ha ez működik (bocs nem bogarásztam végig mit csinál), legegyszerűbb kivenni az útvonal generálást: pld.

sub hivo()
ho = Month(Now) 'melyik hónap van

For c = 1 To ho
call hivatkozás(Format(c, "00"))
next c
end sub

Sub hivatkozás(honap as string)
...
sPath = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019." & honap & "\"
...

(de ha megengedsz egy tanácsot, nem biztos, hogy ez a módszer a legjobb a programozás tanulásához, érdemesebb lenne az egyszerűbb felől (értve) a bonyolultabb felé menni))

2020.01.25. 16:33:35

@Bacsi Kornél:

Sub Listazo()
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i, ho, c As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 1
'ho = Month(Now) '2020-ban melyik hónap van
ho = 12 '2019-re

For c = 1 To ho
Set Folder = FSO.GetFolder("d:\temp\2019\" & Format(c, "00"))
For Each File In Folder.Files
Cells(i + 1, 1) = File.Name
Cells(i + 1, 2) = File.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 3), Address:=File.Path, TextToDisplay:=File.Path
i = i + 1
Next File
Next c
End Sub

2020.01.26. 11:48:55

általánosítva a feladatot:

Sub tesztdirlink()
Call DirLink("d:\mappa", Range("A1")) 'A1-től kezdve linkként a mappa fájlai
End Sub

Sub DirLink(honnan As String, hova As Range)

Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim i As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(honnan)

i = 1
For Each File In Folder.Files
hova.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=File.Path, TextToDisplay:=File.Path
i = i + 1
Next File

End Sub

Ha meg kész szöveg fájlistával dolgozunk (pld. egy dir /b/s kimenete):
Sub ChangeToLink(mit As Range)
Dim c As Range

For Each c In mit.Cells
mit.Hyperlinks.Add Anchor:=c, Address:=c.Value, TextToDisplay:=c.Value
Next c
End Sub

Bacsi Kornél 2020.01.28. 14:41:58

Köszönöm!

Most tudok csak újra foglalkozni a dologgal. Átnézem és jelentkezem. :)
süti beállítások módosítása