windows:programming:vba:filesystemobject-class
FileSystem Klasse
Diese Klasse bietet die Funktion zum rekursiven durchsuchen eines Ordners nach Dateien.
Es können Dateierweiterungen (extensions) angegeben werden, nach denen gefiltert wird.
Erweiterungen sind ODER-Verknüpft.
object.addFilterExtension „txt“ + object.addFilterExtension „doc“ liefern alle Dateien mit der Erweiterung txt oder doc.
Es können Suchmuster (reguläre Ausdrücke) angegeben werden, nach denen gefiltert wird. (Benötigt die Klasse
regExp)
Suchmuster können UND- bzw. ODER-Verknüpft werden. object.RegExpMethod = METHOD_OR bzw. object.RegExpMethod = METHOD_AND
Default sind die Suchmuster UND-Verknüpft.
METHOD_AND: object.addRegExp „*abc*“ + object.addRegExp „*def*“ liefert Dateien in denen abc und def vorkommt
METHOD_OR : object.addRegExp „*abc*“ + object.addRegExp „*def*“ liefert Dateien in denen abc oder def vorkommt
METHOD_AND: (Sinnfrei!
)
object.addRegExp „abc*“ +
object.addRegExp „def*“ liefert Dateien in denen abc und def am Anfang stehen müssen (
liefert nie ein Ergebnis)!
- fileSystem.cls
Private prFiles() As Scripting.file
Private prIsInitprFiles As Boolean
Private prExtensions() As String
Private prIsInitprExtensions As Boolean
Private prRegExpMethod As RegExpMethods
Private prRegExp As regExp
Public Enum RegExpMethods
METHOD_AND = 1
METHOD_OR = 2
End Enum
''' contructor private
''' called on craete Instacne
Private Sub Class_Initialize()
prIsInitprFiles = False
prIsInitprExtensions = False
Set prRegExp = Nothing
prRegExpMethod = METHOD_AND
End Sub
Public Property Let RegExpMethod(ByVal method As RegExpMethods)
prRegExpMethod = method
End Property
Public Function addRegExp(ByVal pattern As String) As Boolean
If prRegExp Is Nothing Then
Set prRegExp = New regExp
End If
prRegExp.addPattern (pattern)
End Function
Public Sub addFilterExtension(ByVal ext As String)
Dim index As Integer
If prIsInitprExtensions Then
index = LBound(prExtensions)
index = index + 1
ReDim Preserve prExtensions(index)
Else
index = 0
ReDim prExtensions(index)
prIsInitprExtensions = True
End If
prExtensions(index) = ext
End Sub
Public Function readFilesRecursive(ByVal path As String) As Scripting.file()
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(path) Then
Dim folder As Scripting.folder
Set folder = fso.GetFolder(path)
prReadFilesRecursive folder
readFilesRecursive = prFiles
Else
'Set readFilesRecursive = Nothing
readFilesRecursive = prFiles
End If
End Function
Private Sub prReadFilesRecursive(ByVal folder As Scripting.folder)
Dim subFolder As Scripting.folder
Dim file As Scripting.file
If folder.files.Count > 0 Then
For Each file In folder.files
prAddReadFilesRecursive file
Next
End If
If folder.SubFolders.Count > 0 Then
For Each subFolder In folder.SubFolders
prReadFilesRecursive subFolder
Next
End If
End Sub
Private Sub prAddReadFilesRecursive(ByVal file As Scripting.file)
If prCheckExtension(file) And prCheckRegExp(file) Then
Dim index As Integer
If prIsInitprFiles Then
index = UBound(prFiles)
index = index + 1
ReDim Preserve prFiles(index)
Else
index = 0
ReDim prFiles(index)
prIsInitprFiles = True
End If
Set prFiles(index) = file
End If
End Sub
Private Function prCheckExtension(ByVal file As Scripting.file) As Boolean
On Error GoTo errHandlerAddFile
Dim hasExtenstion As Boolean: hasExtenstion = False
Dim FileExt As String: FileExt = LCase(getExtensionFromFile(file))
If UBound(prExtensions) >= 0 Then
For Each ext In prExtensions
If LCase(ext) = FileExt Then
hasExtenstion = True
Exit For
End If
Next
End If
If hasExtenstion Then
GoTo errHandlerAddFile
Else
GoTo errHandlerAddFileNoExt
End If
errHandlerAddFile:
prCheckExtension = True
Exit Function
errHandlerAddFileNoExt:
prCheckExtension = False
Exit Function
End Function
Private Function prCheckRegExp(ByVal file As Scripting.file) As Boolean
If prRegExp Is Nothing Then
prCheckRegExp = True
Else
If prRegExpMethod = METHOD_AND Then
prCheckRegExp = prRegExp.RunAnd(file.Name)
Else
prCheckRegExp = prRegExp.RunOr(file.Name)
End If
End If
End Function
Private Function getExtensionFromFile(ByVal oFile As Scripting.file) As String
Dim ext As String
On Error GoTo errHandlerNoFileExtensionFound
ext = Right$(oFile.Name, Len(oFile.Name) - InStrRev(oFile.Name, "."))
getExtensionFromFile = ext
GoTo errHandlerFileExtensionFound
errHandlerNoFileExtensionFound:
getExtensionFromFile = ""
Exit Function
errHandlerFileExtensionFound:
End Function
windows/programming/vba/filesystemobject-class.txt · Zuletzt geändert: 2013/10/19 16:50 von raiser