displaying files

[Idiot2VB]

Hello,

I havent' really worked with files. In my program, I want to have a label, and a command button. When I click the command button, I want the label to show me files on my hard drive like continiously. u know that effect on how when your searching for a file, and it searches all the folders, displaying its name?? Kinda like that. like how anti virus programs search your files fora virus, and display the name of the file and the directory its in...

ok im an idiot. just help please. thanks.

p.s. i just need the names to be displayed.. nothing fancy.

muchas gracias.

[Aaron Young]

You'll need to use a Recursive function, you can do this using the Dir() function, API (as in my example) or using the FileSystemObject.

In a Module

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 lFileCount As Long
 
Public Function FastFindFiles(ByVal sFolder As String, Optional ByVal sPattern As String = "*", Optional ByRef Display As Object) As Variant
    'Initialize the Private File Array and Count, then call the Fast
    'File Recursive Function to populate the Array, then return it.
    lFileCount = 0
    aFileList = Array()
    Screen.MousePointer = vbArrowHourglass
    Call RecurseFindFiles(sFolder, sPattern, Display)
    Screen.MousePointer = vbDefault
    FastFindFiles = aFileList
End Function
 
Private Sub RecurseFindFiles(ByVal sFolder As String, ByVal sPattern As String, Optional ByRef Display As Object)
    Dim tFD As WIN32_FIND_DATA
    Dim lFile As Long
    Dim bFound As Long
    Dim aSubs() As String
    Dim lSubs As Long
    Dim 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 a Display Control was passed, update it.
        If Not Display Is Nothing Then
            Display = ShortenPath(sFolder) & sFilename
            Display.Refresh
        End If
        
        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(lSubs)
                aSubs(lSubs) = sFilename
                lSubs = lSubs + 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(lFileCount)
                aFileList(lFileCount) = sFolder & sFilename
                lFileCount = lFileCount + 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 lSubs Then
        For lSubs = 0 To UBound(aSubs)
            Call RecurseFindFiles(sFolder & aSubs(lSubs), sPattern, Display)
        Next
    End If
End Sub
 
Private Function ShortenPath(ByVal sPath As String) As String
    ' Convert a long path into a shortened version using Ellipses
    Dim sFolder As String
    Dim lPos As Long
    
    ShortenPath = sPath
    If Len(sPath) < 30 Then Exit Function
    sFolder = Mid(sPath, InStrRev(sPath, "\", Len(sPath) - 1) + 1)
    Do While InStr(lPos + 1, sPath, "\") < 30
        lPos = InStr(lPos + 1, sPath, "\")
    Loop
    ShortenPath = Left(sPath, lPos) & "...\" & sFolder
End Function

Example Usage:

Private Sub cmdFind_Click()
    Dim vFiles As Variant
    Dim nFile As Long
    
    vFiles = FastFindFiles("C:\", txtFind, Label1)
    List1.Clear
    For nFile = 0 To UBound(vFiles)
        List1.AddItem vFiles(nFile)
    Next
End Sub