Private
Sub
TestAufruf()
Dim
List$()
Dim
a&, E&
Dim
Ret
Ret = getFiles(List, "C:\",
True
)
Select
Case
Ret
Case
False
MsgBox
"Unexpected exception."
, vbCritical
Exit
Sub
Case
True
Case
Else
MsgBox Ret, vbCritical
Exit
Sub
End
Select
E = UBound(List)
For
a = 0
To
E
Debug.Print List(a)
Next
MsgBox E + 1 &
" files gefunden."
End
Sub
Function
getFiles( _
List$(),
ByVal
Path$, _
Optional
ByVal
Subfolders
As
Boolean
=
False
, _
Optional
ByVal
FilenameFilter$ =
"*"
, _
Optional
ByVal
ExtensionFilter$ =
"*"
_
)
As
Variant
If
Dir(Path) =
""
Then
getFiles =
"Folder doesn't exist"
Exit
Function
End
If
getFiles = ListFiles(List, Path, Subfolders, FilenameFilter, ExtensionFilter)
End
Function
Private
Function
ListFiles(List$(),
ByVal
Path$,
ByVal
Subfolders
As
Boolean
,
ByVal
FilenameFilter$,
ByVal
ExtensionFilter$, _
Optional
ByRef
a& = -1)
As
Boolean
Dim
oFS
As
Object
, OFolder
As
Object
, oSubfolder
As
Object
, OFile
As
Object
Dim
E&, b&, tmp$
On
Error
GoTo
FileListingFailed
Set
oFS = CreateObject(
"Scripting.FileSystemObject"
)
Set
OFolder = oFS.GetFolder(Path)
If
Subfolders
Then
For
Each
oSubfolder
In
OFolder.Subfolders
ListFiles List, oSubfolder.Path, Subfolders, FilenameFilter, ExtensionFilter, a
Next
End
If
E = OFolder.FILES.Count
If
E = 0
Then
Exit
Function
ReDim
Preserve
List(a + E)
tmp = Dir(Path &
"\" & FilenameFilter & "
*" & ExtensionFilter)
While
tmp <>
""
a = a + 1
List(a) = Path & "\" & tmp
tmp = Dir
Wend
ReDim
Preserve
List(a)
ListFiles =
True
FileListingFailed:
Set
OFolder =
Nothing
Set
oFS =
Nothing
Set
oSubfolder =
Nothing
Set
OFile =
Nothing
End
Function