a belate response to
> > know what TrimNull is. One of your children?
HAHAHHAHAHAHAHAH <VBG>
I wudn't hope so ....
Got another one, look at below example.
I believe Peter proposed something similar to below example
as well, using FileSystemObject.
As long as you use the filesearch subroutine recursively ...
Dim fso As FileSystemObject
Dim f As Folder
Dim sf As Folder
Private Sub UserForm_Click()
Me.ListBox1.Clear
FileSearch "d:\"
MsgBox "Number of folders/subfolders: " & Me.ListBox1.ListCount
End Sub
Sub FileSearch(RootFolder As String)
Set f = fso.GetFolder(RootFolder)
With Me.ListBox1
For Each sf In f.SubFolders
.AddItem sf.Name
.List(.ListCount - 1, 1) = sf.Size
.List(.ListCount - 1, 2) = sf.ShortPath
.List(.ListCount - 1, 3) = sf.DateLastModified
FileSearch sf.Path '<< recurse
Next
End With
End Sub
Private Sub UserForm_Initialize()
Set fso = New FileSystemObject
End Sub
Krgrds,
Perry
"Perry" <p.lima@chello.nl> schreef in bericht news:...
> oops
> This fast copying/pasting ...
>
> Here ya go
>
> '******************************************************
> Private Function TrimNull(startstr As String) As String
> Dim pos As Integer
> 'bepaal waar NULL karakter zich bevindt
> pos = InStr(startstr, Chr$(0))
> If pos Then
> 'linker gedeelte voor NULL karakter zoeken we ...
> TrimNull = Left$(startstr, pos - 1)
> Exit Function
> End If
>
> TrimNull = startstr '-> geef terug aan functie
> End Function
>
>
> PdL
>
> "Mark Tangard" <Mark@NoMailPlease_Tangard.com> schreef in bericht
> news:%236RIQUG%23DHA.632@TK2MSFTNGP12.phx.gbl...
> > Perry,
> >
> > Ooooh yeah....
> >
> > I can tell this'll be 100+ times faster than my prior attempt. However,
> > I'm getting an error here (on the last line shown), saying it doesn't
> > know what TrimNull is. One of your children?
> >
> > If hFile <> INVALID_HANDLE_VALUE Then
> > Do
> > If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) And _
> > Asc(WFD.cFileName) <> vbDot Then
> > sTmp = TrimNull(WFD.cFileName)
> >
> > --
> > Mark Tangard, Microsoft Word MVP
> > Note well: MVPs do not work for Microsoft.
> > "Life is nothing if you're not obsessed." --John Waters
> >
> > Perry wrote:
> > > 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" <p.lima@chello.nl> schreef in bericht
> > > news:OeE6e599DHA.3792@TK2MSFTNGP09.phx.gbl...
> > >
> > >>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
> > >>
> > >>"Mark Tangard" <Mark@NoMailPlease_Tangard.com> schreef in bericht
> > >>news:eKCsmQ79DHA.632@TK2MSFTNGP12.phx.gbl...
> > >>
> > >>>Anybody know a way to do the VBA equivalent of clicking
File>Properties
> > >>>on a folder in Windows Explorer?
> > >>>
> > >>>I'd like to get the total number of files, and their combined size,
> > >>>under a given top-level folder. Using the FileSearch object works OK
> > >>>(if slowly) for total size, but it counts folders as files in the
file
> > >>>count, and I don't see a property of FileSearch that can be tested as
> to
> > >>>type.
> > >>>
> > >>>Any clues? TIA.
> > >>>--
> > >>>Mark Tangard, Microsoft Word MVP
> > >>>"Life is nothing if you're not obsessed." --John Waters
> > >>>
> > >>
> > >>
> > >
> > >
> >
>
>