Oke, here's the example
Others may benefit ....
Userform containing:
a Textbox for the rootfolder of yr choosing, called: TextBox1
a Commandbutton, called: Commandbutton1
Some variables are redundant .... i've copied them
straight from a project and simplified as much as possible
you'll have to get rid of them yrself ...
If the abovementioned controls are there, it'll compile/run
and use GetTickCount() API to measure the results against
other algorithms you may have.
I've left out other fancy features like: choosing the rootfolder ...etc bla
y'll have to type the rootfolder in TextBox1 in below example.
It's the search mechanism/algorithm you will like ....
Krgrds,
Perry
==begin Userform module code
Private Const vbDot = 46
Private Const MAXDWORD = &HFFFFFFFF
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Dim lSize As Long
Dim lFileNum As Long
Dim lFolders As Long
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 Type FILE_PARAMS
bRecurse As Boolean
sFileRoot As String
sFileNameExt As String
sResult As String
sMatches As String
Count As Long
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 GetTickCount Lib "kernel32" () As Long
Private Sub CommandButton1_Click()
Dim FP As FILE_PARAMS
'Point to local occurance of error object
'and handle locally
On Local Error GoTo InitError
lSize = 0
lFileNum = 0
lFolders = 0
Me.TextBox1
With FP
.sFileRoot = Me.TextBox1 '<< ROOTFOLDER
.sFileNameExt = "*"
.bRecurse = True
End With
RecursiveFileSearch FP
MsgBox "Size of all files: " & lSize & vbCr & _
"Number of files: " & lFileNum & vbCr & _
"Number of folders: " & lFolders
ExitHere:
Exit Sub
InitError:
MsgBox "catch the error"
Resume ExitHere
End Sub
Private Sub RecursiveFileSearch(FP As FILE_PARAMS)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim sRoot As String
Dim spath As String
Dim fso As New FileSystemObject
Dim MyFolder As Folder
sRoot = QualifyPath(FP.sFileRoot)
spath = sRoot & FP.sFileNameExt
hFile = FindFirstFile(spath, WFD)
'if valid ...
If hFile <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) And _
Asc(WFD.cFileName) <> vbDot Then
sTmp = TrimNull(WFD.cFileName)
If (sTmp <> ".") And (sTmp <> "..") Then
FP.sFileRoot = sRoot & sTmp 'adjust root
FP.Count = FP.Count + 1 'new count
Set MyFolder = fso.GetFolder(sRoot & sTmp)
lFileNum = lFileNum + MyFolder.Files.Count
lSize = lSize + MyFolder.Size
lFolders = FP.Count
RecursiveFileSearch FP '<<< here's the recursive
(intrinsic call to itself) part
End If
End If
Loop While FindNextFile(hFile, WFD)
hFile = FindClose(hFile)
End If
Set fso = Nothing
Exit Sub
Foutje:
Resume Next
End Sub
'******************************************************
Private Function QualifyPath(spath As String) As String
If Right$(spath, 1) <> "\" Then
QualifyPath = spath & "\"
Else: QualifyPath = spath
End If
End Function
==end Userform module code
Perry said:
Mark,
You'll have to use the FindFirstFile() and FindNextFile() API calls to
the kernel32 dll.
These have to be called in a recursive way to get you information
on *all* subdirectories under a given rootfolder.
The below result took me a second (1.06 seconds)
2147483634 bytes (size of all files)
12630 files (number of files)
929 folders (number of folders)
These API's perform super.
Shout, if y're interested in a simple example ...
Krgrds,
Perry
