CountFiles

Private Sub cmdCountAllFiles_Click()
    Dim sSourcePath As String
    Dim sDestination As String
    Dim sFileType As String
    Dim numFiles As Long
    
    'set the appropriate initializing values
    sSourcePath = "c:\win\system\"
    sFileType = "*.*"
    
    'get the count
    numFiles = rgbCountFilesAll(sSourcePath, sFileType)
    MsgBox numFiles & " files found matching " & sSourcePath & sFileType
End Sub

Private Sub cmdCountByAttribute_Click()
    Dim sSourcePath As String
    Dim sDestination As String
    Dim sFileType As String
    Dim sFileAttributes As Long
    Dim numFiles As Long
    
    'set the appropriate initializing values
    sSourcePath = "c:\win\"
    sFileType = "*.*"
    
    'set the attribute(s) to search for
    sFileAttributes = FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_ARCHIVE
    
    'get the count
    numFiles = rgbCountFilesByAttribute(sSourcePath, sFileType, sFileAttributes)
    MsgBox numFiles & " files found matching " & sSourcePath & sFileType & " _
        with attribute(s) " & GetAttributeString(sFileAttributes)
    End Sub

Private Sub cmdListFilesByAttribute_Click()
        Dim sSourcePath As String
        Dim sDestination As String
        Dim sFileType As String
        Dim sFileAttributes As Long
        Dim numFiles As Long
        Dim r As Long
        
        'set the appropriate initializing values
        sSourcePath = "c:\win\"
        sFileType = "*.*"
        
        'set the attribute(s) to search for
        sFileAttributes = FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_ARCHIVE
        
        'clear the list and lock it's window to
        'prevent updating until the search is complete
        List1.Clear
        r = LockWindowUpdate(List1.hWnd)
        DoEvents
        
        'get the list and count
        numFiles = rgbListFilesByAttribute(sSourcePath, sFileType, sFileAttributes)
        
        'free the locked window
        r = LockWindowUpdate(0)
        
        MsgBox numFiles & " files found matching " & sSourcePath & sFileType & " _
            with attribute(s) " & GetAttributeString(sFileAttributes), vbOKOnly, "File Count"
        End Sub

Public Function rgbCountFilesAll(sSourcePath As String, sFileType As String) As Long
            Dim WFD As WIN32_FIND_DATA
            Dim SA As SECURITY_ATTRIBUTES
            
            Dim r As Long
            Dim hFile As Long
            Dim bNext As Long
            Dim fCount As Long
            Dim currFile As String
            
            'Start searching for files in the Source directory by
            'obtaining a file handle to the first file matching the
            'filespec passed
            hFile = FindFirstFile(sSourcePath & sFileType, WFD)
            
            If (hFile = INVALID_HANDLE_VALUE) Then
                
                'no match, so bail out
                rgbCountFilesAll = 0
                Exit Function
                
            End If
            
            'must have at least one, so ...
            If hFile Then
                
                Do
                
                'increment the counter and find the next
                'file matching the filespec
                fCount = fCount + 1
                bNext = FindNextFile(hFile, WFD)
                
                Loop Until bNext = 0
                
            End If
            
            'Close the search handle
            r = FindClose(hFile)
            
            'return the number of files found
            rgbCountFilesAll = fCount
            
        End Function

Public Function rgbCountFilesByAttribute(sSourcePath As String, sFileType _
                As String, AttrFlags As Long) As Long
            Dim WFD As WIN32_FIND_DATA
            Dim SA As SECURITY_ATTRIBUTES
            
            Dim r As Long
            Dim hFile As Long
            Dim bNext As Long
            Dim fCount As Long
            Dim currFile As String
            
            'Start searching for files in the Source directory.
            hFile = FindFirstFile(sSourcePath & sFileType, WFD)
            
            If (hFile = INVALID_HANDLE_VALUE) Then
                
                rgbCountFilesByAttribute = 0
                Exit Function
                
            End If
            
            If hFile Then
                
                Do
                
                'trim trailing nulls, leaving one to terminate the string
                currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
                
                'compare the file attributes against the passes flag(s)
                If AttrFlags And GetFileAttributes(sSourcePath & currFile) Then
                    
                    'increment the counter and find the next
                    'file matching the initial file spec
                    fCount = fCount + 1
                    
                End If
                
                bNext = FindNextFile(hFile, WFD)
                
                Loop Until bNext = 0
                
            End If
            
            'Close the search handle
            r = FindClose(hFile)
            
            'return the number of files
            rgbCountFilesByAttribute = fCount
            
        End Function

Public Function rgbListFilesByAttribute(sSourcePath As String, sFileType As String, _
                AttrFlags As Long) As Long
            Dim WFD As WIN32_FIND_DATA
            Dim SA As SECURITY_ATTRIBUTES
            
            Dim r As Long
            Dim hFile As Long
            Dim bNext As Long
            Dim fCount As Long
            Dim currFile As String
            
            'Start searching for files in the Source directory.
            hFile = FindFirstFile(sSourcePath & sFileType, WFD)
            
            If (hFile = INVALID_HANDLE_VALUE) Then
                
                rgbListFilesByAttribute = 0
                Exit Function
                
            End If
            
            If hFile Then
                
                Do
                
                'trim trailing nulls, leaving one to terminate the string
                currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
                
                'compare the file attributes against the passes flag(s)
                If AttrFlags And GetFileAttributes(sSourcePath & currFile) Then
                    
                    'increment the counter and find the next
                    'file matching the initial file spec
                    List1.AddItem currFile
                    fCount = fCount + 1
                    
                End If
                
                bNext = FindNextFile(hFile, WFD)
                
                Loop Until bNext = 0
                
            End If
            
            'Close the search handle
            r = FindClose(hFile)
            
            'return the number of files fCount
            rgbListFilesByAttribute = fCount
            
        End Function

Public Function GetAttributeString(attr As Long) As String
            Dim tmp As String
            
            If attr And FILE_ATTRIBUTE_ARCHIVE Then tmp = tmp & "ARCHIVE  "
            If attr And FILE_ATTRIBUTE_NORMAL Then tmp = tmp & "NORMAL  "
            If attr And FILE_ATTRIBUTE_HIDDEN Then tmp = tmp & "HIDDEN  "
            If attr And FILE_ATTRIBUTE_READONLY Then tmp = tmp & "READONLY  "
            If attr And FILE_ATTRIBUTE_SYSTEM Then tmp = tmp & "SYSTEM  "
            If attr And FILE_ATTRIBUTE_TEMPORARY Then tmp = tmp & "TEMPORARY  "
            If attr And FILE_ATTRIBUTE_COMPRESSED Then tmp = tmp & "COMPRESSED  "
            If attr And FILE_ATTRIBUTE_DIRECTORY Then tmp = tmp & "DIRECTORY  "
            GetAttributeString = tmp
        End Function

Option Explicit
Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function CreateDirectory Lib "kernel32" _
Alias "CreateDirectoryA" _
(ByVal lpPathName As String, _
lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Declare Function CopyFile Lib "kernel32" _
Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Declare Function GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" _
(ByVal lpFileName As String) As Long
Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
'In the project, add to the form four command buttons

'(cmdCountAllFiles, cmdCountByAttribute, cmdListByAttribute and cmdEnd),

'and a lisbox (List1). Add the following code to the form:

Option Explicit
Private Sub cmdEnd_Click()
Unload Me
End Sub

Private Sub cmdCountAllFiles_Click()
Dim sSourcePath As String
Dim sDestination As String
Dim sFileType As String
Dim numFiles As Long

'set the appropriate initializing values

sSourcePath = "c:\win\system\"
sFileType = "*.*"

'get the count

numFiles = rgbCountFilesAll(sSourcePath, sFileType)
MsgBox numFiles & " files found matching " & sSourcePath & sFileType
End Sub

Private Sub cmdCountByAttribute_Click()
Dim sSourcePath As String
Dim sDestination As String
Dim sFileType As String
Dim sFileAttributes As Long
Dim numFiles As Long

'set the appropriate initializing values

sSourcePath = "c:\win\"
sFileType = "*.*"

'set the attribute(s) to search for

sFileAttributes = FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_ARCHIVE

'get the count

numFiles = rgbCountFilesByAttribute(sSourcePath, sFileType, sFileAttributes)
MsgBox numFiles & " files found matching " & sSourcePath & sFileType & " _
with attribute(s) " & GetAttributeString(sFileAttributes)
End Sub

Private Sub cmdListFilesByAttribute_Click()
Dim sSourcePath As String
Dim sDestination As String
Dim sFileType As String
Dim sFileAttributes As Long
Dim numFiles As Long
Dim r As Long

'set the appropriate initializing values

sSourcePath = "c:\win\"
sFileType = "*.*"

'set the attribute(s) to search for

sFileAttributes = FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_ARCHIVE

'clear the list and lock it's window to

'prevent updating until the search is complete

List1.Clear
r = LockWindowUpdate(List1.hWnd)
DoEvents

'get the list and count

numFiles = rgbListFilesByAttribute(sSourcePath, sFileType, sFileAttributes)

'free the locked window

r = LockWindowUpdate(0)

MsgBox numFiles & " files found matching " & sSourcePath & sFileType & " _
with attribute(s) " & GetAttributeString(sFileAttributes), vbOKOnly, "File Count"
End Sub

Public Function rgbCountFilesAll(sSourcePath As String, sFileType As String) As Long
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES

Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim fCount As Long
Dim currFile As String

'Start searching for files in the Source directory by

'obtaining a file handle to the first file matching the

'filespec passed

hFile = FindFirstFile(sSourcePath & sFileType, WFD)

If (hFile = INVALID_HANDLE_VALUE) Then

'no match, so bail out

rgbCountFilesAll = 0
Exit Function

End If

'must have at least one, so ...

If hFile Then

Do

'increment the counter and find the next

'file matching the filespec

fCount = fCount + 1
bNext = FindNextFile(hFile, WFD)

Loop Until bNext = 0

End If

'Close the search handle

r = FindClose(hFile)

'return the number of files found

rgbCountFilesAll = fCount

End Function

Public Function rgbCountFilesByAttribute(sSourcePath As String, sFileType _
As String, AttrFlags As Long) As Long
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES

Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim fCount As Long
Dim currFile As String

'Start searching for files in the Source directory.

hFile = FindFirstFile(sSourcePath & sFileType, WFD)

If (hFile = INVALID_HANDLE_VALUE) Then

rgbCountFilesByAttribute = 0
Exit Function

End If

If hFile Then

Do

'trim trailing nulls, leaving one to terminate the string

currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))

'compare the file attributes against the passes flag(s)

If AttrFlags And GetFileAttributes(sSourcePath & currFile) Then

'increment the counter and find the next

'file matching the initial file spec

fCount = fCount + 1

End If

bNext = FindNextFile(hFile, WFD)

Loop Until bNext = 0

End If

'Close the search handle

r = FindClose(hFile)

'return the number of files

rgbCountFilesByAttribute = fCount

End Function

Public Function rgbListFilesByAttribute(sSourcePath As String, sFileType As String, _
AttrFlags As Long) As Long
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES

Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim fCount As Long
Dim currFile As String

'Start searching for files in the Source directory.

hFile = FindFirstFile(sSourcePath & sFileType, WFD)

If (hFile = INVALID_HANDLE_VALUE) Then

rgbListFilesByAttribute = 0
Exit Function

End If

If hFile Then

Do

'trim trailing nulls, leaving one to terminate the string

currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)

'compare the file attributes against the passes flag(s)

If AttrFlags And GetFileAttributes(sSourcePath & currFile) Then

'increment the counter and find the next

'file matching the initial file spec

List1.AddItem currFile
fCount = fCount + 1

End If

bNext = FindNextFile(hFile, WFD)

Loop Until bNext = 0

End If

'Close the search handle

r = FindClose(hFile)

'return the number of files fCount

rgbListFilesByAttribute = fCount

End Function

Public Function GetAttributeString(attr As Long) As String
Dim tmp As String

If attr And FILE_ATTRIBUTE_ARCHIVE Then tmp = tmp & "ARCHIVE "
If attr And FILE_ATTRIBUTE_NORMAL Then tmp = tmp & "NORMAL "
If attr And FILE_ATTRIBUTE_HIDDEN Then tmp = tmp & "HIDDEN "
If attr And FILE_ATTRIBUTE_READONLY Then tmp = tmp & "READONLY "
If attr And FILE_ATTRIBUTE_SYSTEM Then tmp = tmp & "SYSTEM "
If attr And FILE_ATTRIBUTE_TEMPORARY Then tmp = tmp & "TEMPORARY "
If attr And FILE_ATTRIBUTE_COMPRESSED Then tmp = tmp & "COMPRESSED "
If attr And FILE_ATTRIBUTE_DIRECTORY Then tmp = tmp & "DIRECTORY "
GetAttributeString = tmp
End Function