Benutzer-Werkzeuge

Webseiten-Werkzeuge


windows:programming:vba:filesystemobject-class

Inhaltsverzeichnis

FileSystem Klasse

  1. Diese Klasse bietet die Funktion zum rekursiven durchsuchen eines Ordners nach Dateien.
  2. Es können Dateierweiterungen (extensions) angegeben werden, nach denen gefiltert wird.
    1. Erweiterungen sind ODER-Verknüpft.
    2. object.addFilterExtension „txt“ + object.addFilterExtension „doc“ liefern alle Dateien mit der Erweiterung txt oder doc.
  3. Es können Suchmuster (reguläre Ausdrücke) angegeben werden, nach denen gefiltert wird. (Benötigt die Klasse regExp)
    1. Suchmuster können UND- bzw. ODER-Verknüpft werden. object.RegExpMethod = METHOD_OR bzw. object.RegExpMethod = METHOD_AND
    2. Default sind die Suchmuster UND-Verknüpft.
    3. METHOD_AND: object.addRegExp „*abc*“ + object.addRegExp „*def*“ liefert Dateien in denen abc und def vorkommt
    4. METHOD_OR : object.addRegExp „*abc*“ + object.addRegExp „*def*“ liefert Dateien in denen abc oder def vorkommt
    5. 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