Lage en list med ALLE filene i en mappe(inklude...

[Richard87]

Kossen kan eg laga en enkel VB funksjon som søker en mappa og lager et string array som viser ALLE filene i den mappen?

 

koden jeg har nå er denne:

Public Function ListFiles(ByVal Folder As string)
Dim sBuffer As string

if not right(folder,1) = "\" then folder = folder & "\"

sBuffer = Dir(folder & "*", vbDirectory)
do until sbuffer = ""
  if sbuffer <> ".." And sBuffer <> "." then
  If (GetAttr(folder & sBuffer) And vbDirectory) = vbDirectory then
       ListFiles folder & sbuffer
  else 
       debug.print folder & sBuffer
  end if
  sbuffer = Dir '<-- Her får eg erroren
loop
end function

Denne funksjonen begynner med og liste alle filene i folderen, mne det øyeblikket den returnerer første gangen etter en undermappe så klikker Dir() Komandoen...

 

PS. Det er iallefall sirka sånn koden var, jeg har ikke PC'en med programmet på her, så...

Endret 29. mai 2005 av Richard87

[aadnk]

Hvorvidt denne funksjonen er kortfattet og enkel, kan en riktignok diskutere, men jeg tror den skulle løse oppgaven rimelig utmerket:

 

Public Function FileList(Path As String, ByVal Extension As String, Optional SubFolders As Boolean, Optional Attributers As VbFileAttribute = vbNormal) As Collection

 

    ' Skulle formodentlig en feil inntreffe, bør vi umiddelbart avslutte søkeprosessen

    On Error GoTo Feil

   

    Dim sFile As String, AllowAll As Boolean, vFolder As Variant, vFile As Variant

    Dim Folders As New Collection, Result As Collection

   

    ' Lag ny listeklasse

    Set FileList = New Collection

   

    ' Hent første forekomst

    sFile = Dir(ValidPath(Path), Attributers)

   

    ' Søk gjennom hele mappen

    Do Until sFile = ""

       

        ' Dette er ikke filer, og må således ikke innbefattes i returdata

        If Not (sFile = "." Or sFile = "..") Then

       

            ' Inkluder søkeresultatet kun dersom den, ved den interne støtten av 'regular expressions', følger et spesifisert mønster

            If sFile Like Extension Then

                FileList.Add sFile

            End If

           

            ' Vi behøver ikke å lete etter mapper dersom dette ikke er angitt

            If SubFolders Then

           

                ' Avgjør hvorvidt dette er en mappe eller ei

                If Not sFile Like "*.*" Then

                    ' Dette er en mappe

                    Folders.Add sFile

               

                End If

           

            End If

       

        End If

       

        ' Finn neste fil

        sFile = Dir

    Loop

 

    ' Finn filer i undermapper, om anmodet

    If SubFolders Then

   

        ' Gå gjennom alle elementer i klassemodulen med alle mappene

        For Each vFolder In Folders

   

            ' Søk i undermapper

            Set Result = FileList(ValidPath(Path) & vFolder, Extension, True, Attributers)

           

            ' Gå gjennom alle returnerte filer og mapper

            For Each vFile In Result

           

                ' Legg til søkeresultat

                FileList.Add vFolder & "\" & vFile

           

            Next

       

        Next

       

    End If

   

' Søkeprosedyren er ferdig

Exit Function

 

' Feilhåndtereren

Feil:

 

    Select Case Err

    Case 52 ' Bad file name or number

   

        ' Ignorer denne feilen, idet den inntreffer når en forsøker å gjennomgå en tom mappe

   

    Case Else

       

        ' Her kan en evt. vise merknadsboks

        MsgBox "Error " & Err & ": " & Error, vbCritical, "Error"

   

    End Select

 

 

End Function

 

Public Function ValidPath(Path As String) As String

 

  ' Legg til en skråstrek dersom denne mangler i endelsen av strengen

  ValidPath = Path & IIf(Right(Path, 1) = "\", "", "\")

 

End Function

 

Du benytter funksjonen således:

 

Dim Files As Variant, File As Variant

 

' Hent fil- og mappeliste over mappen, samt undermapper

Set Files = FileList("C:\Programfiler", "*", True, vbDirectory)

 

' Vis alle filer funnet i søket

For Each File In Files

    Debug.Print File

Next

 

Dersom du eksempelvis KUN ønsker å finne BMP-filer, kan funksjonen kalles slik:

 

Set Files = FileList("C:\Programfiler", "*.bmp", True, vbNormal)

Endret 30. mai 2005 av aadnk