Tiedostojen listaus

Anonyymi-ap

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ä

19

635

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Anonyymi

      Tulostat dir komennolla tekstitiedostoon, jonka jälkeen avaat sen ekselissä. Sitten "text to columns" ja erottimeksi takakeno.

    • Anonyymi

      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

      • Anonyymi

        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.


      • Anonyymi
        Anonyymi kirjoitti:

        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.


      • Anonyymi
        Anonyymi kirjoitti:

        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.

        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!")


      • Anonyymi
        Anonyymi kirjoitti:

        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


    • Anonyymi

      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".

      • Anonyymi

        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...


    • Anonyymi

      Jos polku on x:\xxxxx\yyyyy\zzzzz, asematunnus on selvä, mutta mitä tarkoitat kansioilla ja alikansioilla?

      • Anonyymi

        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.


    • Anonyymi

      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

      • Anonyymi

        Eihän toi voi toimia kun kutsut funktiota argumenteillä, joita ei ole funktiossasi .
        Tyhmää postata toimimattomia koodinpätkiä...


      • Anonyymi

        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.


      • Anonyymi
        Anonyymi kirjoitti:

        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?


      • Anonyymi
        Anonyymi kirjoitti:

        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ää.


      • Anonyymi
        Anonyymi kirjoitti:

        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:


      • Anonyymi
        Anonyymi kirjoitti:

        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 ...


      • Anonyymi
        Anonyymi kirjoitti:

        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


      • Anonyymi
        Anonyymi kirjoitti:

        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


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Miksei voitaisi vaan puhua asiat selväksi?

      Minulla on ollut niin kova ikävä sinua, etten oikein edes löydä sanoja kuvaamaan sitä. Tuntuu kuin jokainen hetki ilman
      Ikävä
      50
      1633
    2. Sunnuntai terveiset kaivatulle

      Maa on vielä valkoinen vaikka vappu lähestyy, otetaan pitkästä aikaa pyhä terveiset kaivatullesi tähän ketjuun !!
      Ikävä
      76
      1365
    3. Kaupan työtekijä

      Kyllä on pahaa katsottavaa kun myyjällä on purtu kaula, hyvin epäsoveliasta
      Kuhmo
      31
      1181
    4. Olen päivä päivältä vain varmempi siitä että rakastan sinua

      Onhan se tällä tuntemisen asteella jokseenkin outoa, mutta olen outo ja tunne on tunne. 😊
      Ikävä
      89
      1104
    5. Oletko koskaan suuttunut jostain kaivatullesi?

      Mitä hän teki tai mitä tapahtui, mistä suutuit?
      Ikävä
      89
      996
    6. Verovähennysten poisto syö veronkevennykset pieni- ja keskituloisilta

      Kokoomuslaiset ja perussuomalaiset kansanedustajat jakavat kilvan postauksia, jossa kerrotaan miten kaikkien työssäkäyvi
      Maailman menoa
      143
      968
    7. Ai miehillä ei ole varaa maksaa

      Treffejä naiselle johon on ihastunut? Ihanko totta dusty miehet? Tekosyy. Haluatko laittaa 50/50 kaikki kulut parisuhtee
      Ikävä
      191
      944
    8. Olet mielessäni

      viimeisenä illalla ja ensimmäisenä aamulla. Ihastuin sinuun enkä voi tunteilleni mitään. Jos uskaltaisin, tunnustaisin s
      Ikävä
      20
      871
    9. 71
      834
    10. Olen paremman näköinen kuin sinä

      Jos aletaan sille tielle mies.
      Ikävä
      82
      831
    Aihe