Moi
Tartteisin apua kansioiden ja tiedostojen nimien kokoamiseksi yhteen taulukkoon,
johon luetaan kaikki asemat F-asemasta eteenpäin. Polku on sama kaikissa asemissa
asematunnusta lukuunottamatta (x:\xxxxx\yyyyy\zzzzz).
- asematunnus A5 lähtien
- kansioiden (B5), alikansioiden (C5) ja tiedostojen listaus D5 lähtien
- tulostus ilman välirivejä
Tartteisin apua kansioiden ja tiedostojen nimien kokoamiseksi yhteen taulukkoon,
johon luetaan kaikki asemat F-asemasta eteenpäin. Polku on sama kaikissa asemissa
asematunnusta lukuunottamatta (x:\xxxxx\yyyyy\zzzzz).
- asematunnus A5 lähtien
- kansioiden (B5), alikansioiden (C5) ja tiedostojen listaus D5 lähtien
- tulostus ilman välirivejä
Vastaukset 19
Vanhimmat
Tulostat dir komennolla tekstitiedostoon, jonka jälkeen avaat sen ekselissä. Sitten "text to columns" ja erottimeksi takakeno.
Sub ListFilesInFolder()
Dim ws As Worksheet
Dim folderPath As String
Dim fileName As String
Dim row As Long
Dim col As Long
Set ws = ThisWorkbook.Sheets("Sheet1") ' Muuta tarvittaessa oikea taulukkonimi
row = 5 ' Aloitussolu
Do While ws.Cells(row, 1).Value <> ""
folderPath = ws.Cells(row, 1).Value
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*")
col = 2 ' Aloitussarake (B)
Do While fileName <> ""
ws.Cells(row, col).Value = fileName
fileName = Dir
col = col + 1
Loop
row = row + 1
Loop
End Sub
Moi.
Siinähän taas meni jokunen päivä ja nyt sit takas koneelle. Mites toi koodi, kun ei levyasemilta ainakaan lue. Tarkotus oli lukee asemilta tietoi taulukkoon.
Asematunnus pitää vaihtaa A:han tai B:hen.
Hei
Oletin että sinulla excelissä alkaen solusta A5 ja siitä alas on sen aseman osoite valmiina minkä tiedot haluat viereisiin sarakeisiin.
Jos haluat lukea ulos kaikki tiedostot määritellyistä osoitteista tee seuraavasti.
Avaa notepad ja kopio alla oleva rimpsu siihen.
tee siihen seuraavat muutokset
kohta D:\siivous. Tämän tilalle se paikka minne haluat txt logitiedoston luotavan.
kohta D:\Data\desktop. Tähän sen aseman/kansion osoite jonka siällön haluat txt logiin.
Tallenna notepad tiedosto haluamasi nimellä ja päätteeksi .vbs.
Tallennuksen jälkeen etsi tallentamasi vbs ja tupla klikkaa, ajo alkaa ja hetken kuluttua sulla logi txt
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.CreateTextFile("D:\siivous.txt") '<---------------- creates an output file located here
objLogFile.WriteLine "Type|ParentFolder|Name|DateCreated|DateLastModified|DateLastAccessed|Size"
LoopSubFolders objFSO.GetFolder("D:\Data\Desktop\") '<----------------- path for analysis
Sub LoopSubFolders(Folder)
For Each SubFolder In Folder.SubFolders
LoopSubFolders SubFolder
For Each objFile In SubFolder.Files
On Error Resume Next
objLogFile.WriteLine objFile.Type & "|" & _
objFile.ParentFolder & "|" & _
objFile.Name & "|" & _
objFile.DateCreated & "|" & _
objFile.DateLastModified & "|" & _
objFile.DateLastAccessed & "|" & _
objFile.Size
Next
Next
End Sub
MsgBox ("Log File completed!")
Moi
Virhettä pukkaa...
Komentosarja: C:\Testi\Lista.vbs
Rivi: 2
Merkki: 1
Virhe: Ei käyttöoikeutta
Koodi: 800A0046
Lähde: Suorituksenaikainen Microsoft VBScript virhe
Vaihe 1: Luo VBA-makro
Avaa Excel.
Paina Alt + F11 avataksesi VBA-editorin.
Valitse "Insert" > "Module" luodaksesi uuden moduulin.
Liitä seuraava koodi moduuliin:
Sub ListFilesAndFolders()
Dim folderPath As String
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Dim fso As Object
Dim row As Long
Dim driveLetter As String
Dim i As Integer
' Aseta asematunnus
For i = 5 To 26 ' Asematunnukset A5:Z5
driveLetter = Chr(64 + i) & ":\"
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(driveLetter & "xxxxx\yyyyy\zzzzz") ' Muokkaa polkua tarpeen mukaan
If Not folder Is Nothing Then
row = Cells(Rows.Count, 2).End(xlUp).Row + 1 ' Aloita B-sarakkeesta
Call ListFolderContents(folder, row)
End If
On Error GoTo 0
Next i
End Sub
Sub ListFolderContents(folder As Object, ByRef row As Long)
Dim subfolder As Object
Dim file As Object
' Listaa kansiot
For Each subfolder In folder.SubFolders
Cells(row, 2).Value = subfolder.Name ' Kansio
Cells(row, 3).Value = "" ' Alikansio (tyhjää)
Cells(row, 4).Value = "" ' Tiedosto (tyhjää)
row = row + 1
Call ListFolderContents(subfolder, row) ' Kutsutaan rekursiivisesti alikansioita
Next subfolder
' Listaa tiedostot
For Each file In folder.Files
Cells(row, 2).Value = "" ' Kansio (tyhjää)
Cells(row, 3).Value = "" ' Alikansio (tyhjää)
Cells(row, 4).Value = file.Name ' Tiedosto
row = row + 1
Next file
End Sub
Vaihe 2: Suorita makro
Palaa Exceliin ja tallenna tiedosto makroilla (xlsx-tiedosto ei tue makroja, joten tallenna se .xlsm-muodossa).
Paina Alt + F8, valitse ListFilesAndFolders ja paina "Run".
Moi
Pienellä testauksella muutama huomio. Toi asematunnus ei toimi mut silmukkanumeroo vaihtamalla, saa kyl oikeen aseman osuu kohalleen. Sit tiedostojen haussa vois olla tarkennin mukana, jonka mukaan sais rajata hakui.
Annetun kansion tiedostot se hakee, mut vois olla hyvä, jos aseman ekasta kansiosta vikaan tekis haun samaan pötköön. Kiitti, jos jaksat naputella...
Jos polku on x:\xxxxx\yyyyy\zzzzz, asematunnus on selvä, mutta mitä tarkoitat kansioilla ja alikansioilla?
Moi
Kun oon nyt rimpuillut ton kanssa niin "ajatus on selkee", kunhan vaan saisin selitetyksi. Ite en noita hakutoimintoja oikein osaa, mutta toivottavasti pikkuhiljaa se kirkastus. Paljon sain irti tosta sun aiemmasta jutusta, mutta näin olisi tarkoitus mennä. Vähän on ajatus alun jälkeen muuttunut.
Asematunnus B5 soluun
- aseman eka kansio C5 soluun, jos kansiossa on tiedostoja, niin C6 alaspäin
- jos ekalla kansiolla on alikansio, niin D5 soluun kansion nimi
- ja D6 solusta lähtien sen kansion tiedostot
Näin rempataan kaikki alikansiot seuraaviin sarakkeisiin tiedostoineen, jonka jälkeen siirrytään aseman "toiseen" kansioon ja sen alikansioihin, ja tehdään sama remppa. Toinen kansio tulostetaan ekan kansion/alikansioiden tiedostojen alimman rivin, plus yhden välirivin jälkeen. Näin mennään aseman kaikki kansiot läpi.
Eka asema tulostetaan Taul2 -välilehdelle (Taul1 jää koontitiedostolle), ja kun siirrytään seuraaviin asematunnuksiin, niin ne tulostettaisiin seuraaville välilehdille.
Alempana olevassa linkissä oli lähes sama kysymys. Siihen oli kaksi vaihtoehtoista ratkaisua. Muokkasin vain ensimmäisen vaihtoehdon pääohjelmaa, joka on tässä alla. Muu pysyy ennallaan.
Alkuperäinen ei näytä asematunnusta, vaan sen paikalle tulee tyhjää. Oikaisin sen verran, että asematunnus kirjoitetaan pääohjelmassa, tulostus merkitään alkamaan toisesta sarakkeesta lähtien, ja lopuksi poistetaan tyhjä toinen sarake.
Jos oli tarkoitus käydä hakemistot, jotka ovat tietyn polun päässä, lisää polku For-lauseen jälkeiselle riville: asema = Chr(a) & ":\polku". Tämä tulostuu silloin sarakkeeseen A.
https://www.mrexcel.com/board/threads/vba-to-list-all-folders-subfolders-and-files-in-a-directory.1199314/
Option Explicit
Public Sub Main_List_Folders_and_Files()
Dim alku, loppu, a, r
Dim asema As String
alku = Asc("C") ' Ensimmäinen levyasema
loppu = Asc("D") ' Viimeinen levyasema
With ActiveSheet
.Cells.Clear
r = 5
For a = alku To loppu
asema = Chr(a) & ":"
.Cells(r, 1) = asema
r = r + List_Folders_and_Files(asema, .Cells(r, 2))
Next a
.Cells(r, 1) = "Loppu"
.Columns(2).Delete
End With
End Sub
Eihän toi voi toimia kun kutsut funktiota argumenteillä, joita ei ole funktiossasi .
Tyhmää postata toimimattomia koodinpätkiä...
Moi
Otin sen ekan listauksen ja vaihoin siihen ton sun tekemän alun.
Jos ekaks asemaks laittaa C, niin kansioks nappaa Documents ja alkaa myllyttää sieltä tiedostoi ja sit kansioi ja niiden tiedostoi reippaat 270, kunnes tilttaa Permission denied virheilmotukseen.
Jos taasen ekaks asemaks antaa G, aloittaa tiedostoilla Autorun.inf, BackuoPlusDeskIcon.ico, $RECYCLE.BIN sekä sen jälkeen vielä pieni kirjain/numero sarja väliviivoilla erotettuina. Sekin päättyy tohon samaan ilmotukseen.
Minulla tuo toimi ainakin temp -hakemistoilla.
Jos on hakemistoja, joille ei ole oikeuksia, tulee varmaankin virhe.
Pääsetkö katsomaan kaikki hakemistot manuaalisesti?
Moi
Kaikki asemat toimii ok, ei mitään ongelmia. Mun noi ulkoiset data-asemat ei sisällä muuta kuin omia tekemiä kansioita ja niiden tiedostoja. Luuraahan siel toi recycle.bin kun se siihen törmää, oiskohan aseman mukana tulleen varmuuskopiointiohjelman juttui. Mut jos haetaan ekana kansio ja sitten siihen kuuluvat tiedostot, niin miten se tohon törmää.
Kokeilin monia kansioita ja useimpien kanssa ei ollut ongelmia, mutta esim hakemistossa C:\ProgamData tuli Access denied -virhe useiden alihakemistojen kohdalla. Kokeile suraavaa yksinkertaista virheenkäsittelyä aliohjelmaan List_Folders_and_Files. Se kirjoittaa virheilmoitukset VBA:n immediate-ikkunaan ja jatkaa seuraavaan hakemistoon.
Lisää rivin
c = c + 1
jälkeen rivi
On Error GoTo virhe:
Lisää ennen lopun riviä
Loop
seuraavat rivit
virhe:
If Err.Number > 0 Then
Debug.Print Err.Number, Err.Description
Err.Clear
Resume ohi:
End If
ohi:
Moi
Johan tuli ruudulle elämää, tosta peukku ylös ja kiitti. Virheilmotuksii pukkas suhtkoht noin 50 kpl, kun kaksi asemaa tsekkasin ja kaikissa luki 70 Permission denied.
Nyt kun kattoo tota listausta, niin olis muutama tarve lisäriveille. Mihin tulis rivi ja millanen, jolla vois suodattaa muutamien tarkentimen mukaan tulostettavat tiedostot. Sais tarvekohtasii viimeistelympii tsekkauksii.
Entä miten ratkeis pien ongelma kansioiden kanssa. Kun niiden määrä ylittää kymmenen esim. Kansio 1, Kansio 10, Kansio 11, Kansio 2, Kansio 3, niin se pukkaa noi ykkösellä alkavat tohon keulaan, eikä 1,2,3 ...
Jos hakemistot haluaa numerojärjestykseen, on yksinkertaisinta muuttaa niiden nimien numero-osat etunollilla yhtä pitkiksi: Kansio 1 --> Kansio 01.
En ihan ymmärtänyt, millaista valintaa tarvitsisit. Käykö Excelin filtteri (Ctrl+Shift+L)? Jotta suodatus onnistuu järkevästi, on joka riville lisättävä kaikkien hakemistopolun hakemistojen nimet. Filtteri tarvitsee myös otsikot, joten käytössä olevien sarakkeiden kirjaintunnukset tulevat otsikoiksi riville 4.
Dim LastRow
Sub täytä()
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
LastCol = ActiveSheet.UsedRange.Columns.Count
For s = 1 To LastCol
Cells(4, s) = Chr(64 + s)
sarake (s)
Next s
End Sub
Sub sarake(c)
r = 5
Do While Cells(r, c) = ""
r = r + 1
Loop
Do
hakemisto = Cells(r, c)
r = r + 1
Do While Cells(r, c) = "" And r < LastRow
lc = Cells(r, Columns.Count).End(xlToLeft).Column
If c < lc Then Cells(r, c) = hakemisto
r = r + 1
Loop
If r >= LastRow Then Exit Sub
Loop
End Sub
Saattaa olla hyödyllistä eritellä hakemistot ja tiedostot. Tämä lisää yhden sarakkeen ja merkkaa hakemistojen kodalle merkin X. Aliohjelma sarake on entinen.
Sub täytä()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
LastCol = ActiveSheet.UsedRange.Columns.Count
For s = 1 To LastCol
Cells(4, s) = Chr(64 + s)
sarake (s)
Next s
Cells(4, s) = Chr(64 + s)
For r = 5 To LastRow - 1
polku = Cells(r, 1)
For c = 2 To Cells(r, Columns.Count).End(xlToLeft).Column
polku = polku & "\" & Cells(r, c)
Next c
If fso.FolderExists(polku) Then Cells(r, LastCol + 1) = "X"
Next r
End Sub