Keskustelu: Ohjelmointikysymykset: VBA: Hakemistojen listaaminen (VB)

Cc [15.12.2004 19:15:07]

Miksi minun koodini ei suostu listaamaan kansioita? apua?

***formille
Option Explicit
Private Sub Form_Load()
If Dir("C:\Listatut", vbDirectory) = "" Then
  MkDir "C:\Listatut"
End If
End Sub
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
Public Sub Command2_click()
Dim Item As Variant
    For Each Item In GetFileList(Dir1.Path)
        List1.AddItem Item
    Next
If Dir("C:\Listatut", vbDirectory) = "" Then
  MkDir "C:\Listatut"
End If
Open "C:\Listatut\Lista.txt" For Append As #1
Print #1, "Tiedostot:"
Print #1, Item
Close #1
End Sub

***moduuliin
Option Explicit
Public Function GetFileList(ByVal Folder As String)
    If Right$(Folder, 1) <> "\" Then Folder = Folder & "\"
    Dim Files As New Collection
    ScanFolder Folder, Files
    Set GetFileList = Files
End Function
Private Function ScanFolder(Folder As String, Files As Collection)
    Dim FolderItem As Variant, NewItem As String, Attr As Long
    For Each FolderItem In FolderItems(Folder)
        NewItem = Folder & FolderItem
        On Error Resume Next
        Attr = GetAttr(NewItem)
        If Err Then GoTo NextItem
        On Error GoTo 0
        If Attr And vbDirectory Then
            ScanFolder NewItem & "\", Files
        Else
            Files.Add NewItem
        End If
NextItem:
    Next
End Function
Private Function FolderItems(Folder As String) As Collection
    Dim C As New Collection, S As String
    S = Dir(Folder, vbDirectory Or vbHidden Or vbSystem)
    Do Until S = vbNullString
        If S <> "." And S <> ".." Then C.Add S
        S = Dir
    Loop
    Set FolderItems = C
End Function

tuomas [15.12.2004 19:39:47]

1. Olisi hyvä kertoa tarkkaan mikä ei toimi. Ei tyyliin: "tossa on koodi, mikä kusee?"
2. Rivi jota debuggeri mahdollisesti herjaa olisi myös hyvä kertoa.
3.Kertaa kohdat yksi ja kaksi.

Antti Laaksonen [15.12.2004 19:51:30]

Kerro kunnollisesti, mitä olet tekemässä, niin voidaan auttaa...

Cc [15.12.2004 19:52:53]

Tuomas: En tiedä mikä kusee... se ei vaan suostu kirjottamaan tuohon "listatut.txt" tiedostoon muuta kuin tuon "Tiedostot:" vaikka sen pitäisi kirjoittaa mitä kansio sisältää. dir1.pathilla pitäisi valita kansio josta se listaa tiedostot. Esim Jos dir1 on kansio E:\Tämä niin sen pitäisi listata sen kansion sisältö.

Debugger ei herjaa mitään...

EDIT: Antti Laaksonen: Olen tekemässä ohjelmaa joka listaa kansiot ja ali kansiot sen on tarkoitus kirjoittaa tiedostot mitä kansio(t) sisältää teksti tiedostoon joka tallentuu "C:\Listatut\Lista.txt"
Mutta se ei suostu kirjoittamaan tonne teksti tiedostoon mitään muuta kuin tuon "Tiedostot:"... Apuja?

Cc [15.12.2004 22:45:03]

Sain toimimaan kun laitoin tuon tekstitiedostoon kirjoituksen tuonne

Dim Item As Variant
    For Each Item In GetFileList(Dir1.Path)
        List1.AddItem Item
    Next

väliin

Cc [21.12.2004 21:44:59]

Olen vieläkin pikkuisen viimeistelemässä tätä tiedoston listaus ohjelmaa mutta sain kaiken tehtyä mutta törmäsin ongelmaa kun yritin listata musiikkiani. Ohjelma ei suostu listaamaan kovalevyn sisältöä vain kansion sisällön. Siis kun valitsen Drivelistboxista kovalevyn ja pidän dirlistboxissa sen juuri kansiossa (D:\) niin se sanoo että

"Run time error '52':
Bad file name or number"

Ongelma on moduulilla

***Moduuli
Option Explicit
Public Function GetFileList(ByVal Folder As String)
    If Right$(Folder, 1) <> "\" Then Folder = Folder & "\"
    Dim Files As New Collection
    ScanFolder Folder, Files
    Set GetFileList = Files
End Function
Private Function ScanFolder(Folder As String, Files As Collection)
    Dim FolderItem As Variant, NewItem As String, Attr As Long
    For Each FolderItem In FolderItems(Folder)
        NewItem = Folder & FolderItem
        On Error Resume Next
        Attr = GetAttr(NewItem)
        If Err Then GoTo NextItem
        On Error GoTo 0
        If Attr And vbDirectory Then
            ScanFolder NewItem & "\", Files
        Else
            Files.Add NewItem
        End If
NextItem:
    Next
End Function
Private Function FolderItems(Folder As String) As Collection
    Dim C As New Collection, S As String
    S = Dir(Folder, vbArchive Or vbDirectory Or vbHidden Or vbSystem) 'virhe on tällä rivillä
    Do Until S = vbNullString
        If S <> "." And S <> ".." Then C.Add S
        S = Dir
    Loop
    Set FolderItems = C
End Function

Antti Laaksonen [21.12.2004 23:07:14]

Minulla koodi toimi moitteettomasti sekä kiintolevyllä (C:\) että levykkeellä (A:\). Kun yritin lukea tyhjää CD-asemaa (D:\), tuli sen sijaan sama virheilmoitus kuin sinulla. Koodissa on otettu huomioon hakemistolistassa oleva bugi (juurihakemistossa on kenoviiva, mutta alihakemistoissa ei), joten sen suhteen ei pitäisi olla ongelmia. Tarkista Folder-muuttujan arvo virheen aiheuttavalla rivillä!

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät