Getting files from folder (the names )

[Evan]

How can I search the folder "C:\arthurium\"
for all of it files (include files in directories
under the top) and put the file names in a array?

Thanks alot!

[Edited by Evan on 08-20-2000 at 10:09 PM]

[kedaman]

'Put this in a module
Option Explicit
Public filemax&
Public diremax&
Sub explore(startdir$, files$(), Optional pauses = 100)
    filemax = 0: diremax = 0:
    If Right(startdir, 1) <> "\" Then startdir = startdir & "\"
    SubFiles startdir, pauses
End Sub

Function SubFiles(Path$, files$(), Optional pauses = 100): Dim i&, dmax&, dirname$, dire$(), waiter&
    dirname = Dir(Path, 63)
    Do While dirname <> ""
        If dirname <> "." And dirname <> ".." Then
            If Int(GetAttr(Path + dirname) / 16) Mod 2 = 1 Then
                    If (dmax Mod 10) = 0 Then
                        ReDim Preserve dire(dmax + 10)    ' Resize the array.
                    End If
                diremax = diremax + 1: dmax = dmax + 1
                dire(dmax) = dirname
            Else
                filemax = filemax + 1
                ReDim Preserve files(filemax - 1)
                files(filemax - 1) = Path & dirname
            End If
        End If
            dirname = Dir   ' Get another directory name.
        waiter = waiter + 1: If waiter Mod (pauses) = 1 Then DoEvents
    Loop
    For i = 1 To dmax
        SubFiles Path & dire(i) & "\"
    Next i
End Function

'Usage
Dim a() As String
explore "C:\athurium", a

You could also do it the DOS way ;].

Shell ("command.com /c dir /b c:\arthurium\ > c:\arthurium.txt"), vbNormalFocus

And then continue on from there....

[kedaman]

I think the DOS way is a bit ugly, i once tried it but it's a hell to separate all the filenames and stuff from the listings

[kedaman]

BTW, here's something Aaron once posted

Option Explicit

'API Consts, Types and Functions
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private aFileList As Variant
Private nFileCount As Long

Function FastFindFiles(ByVal sFolder As String, Optional ByVal sPattern As String = "*") As Variant
    'Initialize the Private File Array and Count, then call the Fast
    'File Recursive Function to populate the Array, then return it.
    nFileCount = 0
    aFileList = Array()
    Screen.MousePointer = vbArrowHourglass
    Call RecurseFindFiles(sFolder, sPattern)
    Screen.MousePointer = vbDefault
    FastFindFiles = aFileList
End Function

Private Sub RecurseFindFiles(ByVal sFolder As String, ByVal sPattern As String)
Dim tFD As WIN32_FIND_DATA, lFile As Long, bFound As Long, aSubs() As String, nSubs As Long, sFilename As String
    
    'Make sure the passed folder includes an ending "\"
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    
    'Find the First File in the Specified Location
    lFile = FindFirstFile(sFolder & "*", tFD)
    bFound = lFile
    
    'Loop while a File is found
    While bFound
        'Get the Filename
        sFilename = UCase(Left(tFD.cFileName, InStr(tFD.cFileName, Chr(0)) - 1))
        If (tFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            'If it's a Folder, add it to the Sub Folders Array
            If Left(sFilename, 1) <> "." Then
                ReDim Preserve aSubs(nSubs)
                aSubs(nSubs) = sFilename
                nSubs = nSubs + 1
            End If
        Else
            'If it's a File, compare it to the Pattern for a Match
            If sFilename Like UCase(sPattern) Then
                'If it matches, add it to the File Array
                ReDim Preserve aFileList(nFileCount)
                aFileList(nFileCount) = sFolder & sFilename
                nFileCount = nFileCount + 1
            End If
        End If
        'Find the Next File, (if there is one).
        bFound = FindNextFile(lFile, tFD)
    Wend
    'Close the API Find Handle
    Call FindClose(lFile)
    
    'If there were Sub Folders found, Recurse them too..
    If nSubs Then
        For nSubs = 0 To UBound(aSubs)
            Call RecurseFindFiles(sFolder & aSubs(nSubs), sPattern)
        Next
    End If
End Sub

Which is probably not only the fastest way to find the files, but also to list them

Dim A as variant
A = FastFindFiles ("c:\arthurium")

Why not just add the outputted dos file containing the filenames into a Listbox?

Public Sub List_Add(List As ListBox, txt As String)
List.AddItem txt
End Sub

Public Sub List_Load(TheList As ListBox, FileName As String)
On Error Resume Next
Dim TheContents As String
Dim fFile As Integer
fFile = FreeFile
 Open FileName For Input As fFile
   Do
     Line Input #fFile, TheContents$
        Call List_Add(TheList, TheContents$)
   Loop Until EOF(fFile)
 Close fFile
End Sub

'Usage:
Call List_Load(List1, "c:\arthurium.txt")

[kedaman]

First, i think he want's it in an array, second i think he want's to do it without extra files, third, i think he want's to have it done as fast as possible.

[Evan]

Thats so wonderfull..

Thanks so much!!!!!