Filecount

Does anybody know how to get the totall amount of files on a machine? Without searching for them 1 by 1.

Im making a progress bar that gets the # of files on your computer, and then scans them giving the user the progress. But i cant find a way without looking for all the files on the computer first and counting them.
HELP!

Thanks in advance!

Here's a really fast Search routine which uses the API to get the most speed possible, on my PIII 600Mhz it returned a list of 24,000 files in less than 3 seconds:

In a Module:

Code:

---

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

Public Function FastFindFiles(ByVal sFolder As String, Optional ByVal sPattern As String = "*") As Variant
    nFileCount = 0
    aFileList = Array()
    Call RecurseFindFiles(sFolder, sPattern)
    FastFindFiles = aFileList
End Function

Private Sub RecurseFindFiles(ByVal sFolder As String, ByVal sPattern As String)
    Dim tFD As WIN32_FIND_DATA
    Dim lFile As Long
    Dim bFound As Long
    Dim aSubs() As String
    Dim nSubs As Long
    Dim sFilename As String
   
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
   
    lFile = FindFirstFile(sFolder & "*", tFD)
    bFound = lFile
   
    While bFound
        sFilename = UCase(Left(tFD.cFileName, InStr(tFD.cFileName, Chr(0)) - 1))
        If (tFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            If Left(sFilename, 1) <> "." Then
                ReDim Preserve aSubs(nSubs)
                aSubs(nSubs) = sFilename
                nSubs = nSubs + 1
            End If
        Else
            If sFilename Like UCase(sPattern) Then
                ReDim Preserve aFileList(nFileCount)
                aFileList(nFileCount) = sFolder & sFilename
                nFileCount = nFileCount + 1
            End If
        End If
        bFound = FindNextFile(lFile, tFD)
    Wend
    Call FindClose(lFile)
    If nSubs Then
        For nSubs = 0 To UBound(aSubs)
            Call RecurseFindFiles(sFolder & aSubs(nSubs), sPattern)
        Next
    End If
End Sub

---

Example:

Code:

---

Private Sub Command1_Click()
    Dim tTimer As Single
    Dim nCount As Long
    Dim aList As Variant
   
    tTimer = Timer
    aList = FastFindFiles("C:\", "*.*")
   
    MsgBox UBound(aList) + 1 & " Files found in " & (Timer - tTimer) & " seconds."
   
    List1.Clear
    For nCount = 0 To UBound(aList)
        List1.AddItem aList(nCount)
    Next
End Sub

---