1 1 1 1 1 1 1 1 1 1 Rating 0.00 (0 Votes)

Problemstellung:

Nur für 32Bit Office Versionen

 
Wie man Dateien in eine MS-Access DB einlesen kann hatte ich schon in
2 verschiedenen Lösungen gezeigt.
 

Jetzt kam aber die Frage auf wie man die Suchroutine dahin gehend ändern kann, dass nur
bis zu einer bestimmten Ordnertiefe suchen kann?
Die Lösung dafür möchte ich hier vorstellen.

Voraussetzungen:
Das Bsp ist ab A00 lauffähig.

Funktionsweise:
In der Bsp-DB befinden sich ein Klassenmodul und 2 Module.
Auf die Erklärung der 2 Module verzichte ich, denn diese dürften selbst erklärend sein.
Kernstück ist das Klassenmodul "cls_ListFiles". Damit wird die Dateistruktur in eine Collection eingelesen.

Public Col_File As Collection

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
                          Optional bIncludeSubfolders As Boolean)
On Error GoTo Err_Handler

    Dim colDirList As New Collection
    Dim temp_col As New Collection
    Dim varItem As Variant

    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

    For Each varItem In colDirList
        temp_col.Add varItem
    Next
    Set Col_File = temp_col

Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
                         bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function
 
Diese Klasse wird dann in der Sub "ReadFolder" im Formular aufgerufen.
Die Sub erwartet 4 Parameter:
 
1. strFolder = Sartverzeichnis
2. strFilter = den Dateifilter
3. bSubfolder = mit oder ohne Unterverzeichnisse (Optional, Standardwert = Falsch)
4. iDepth = die Ordnertiefe (Optional, Standardwert = 0, alle Unterverzeichnisse)
 
Hinweis:
Ist bSubfolder=False wird der Parameter iDepth ignoriert.

Dim cLFs As New cls_ListFiles

Private Sub ReadFolder(strFolder As String, strFilter As String, Optional bSubfolder As Boolean = False, _
                       Optional iDepth As Integer = 0)
    
    Dim x
    Dim i As Long, nCount As Long
    Dim rs As DAO.Recordset, db As DAO.Database
    Dim tSplitPath As SplitPath
    Dim iLen As Integer, sTemp As String, iCountSign As Integer

    On Error GoTo Folder_Error
    
    Set db = CurrentDb
    nCount = 0
    'Klasse zum Einlesen der Dateien aufrufen
    x = cLFs.ListFiles(strFolder, strFilter, bSubfolder)
    ' Anzahl der gefunden Dateien anzeigen
    If iDepth = 0 Then Me.lbl_CountFiles.Caption = cLFs.Col_File.Count _
                & " Dateien nach den Kriterien gefunden"
    
    Set rs = db.OpenRecordset("tbl_Files", dbOpenDynaset)
    DoCmd.Echo False, "Bitte warten..., die Tabelle 'Files' wird mit Daten gefüllt"
    
    'Länge des Startverzeichnisses ermitteln
    iLen = Len(strFolder)
    For i = 1 To cLFs.Col_File.Count
        If iDepth = 0 Then
        'Keine Beschränkung der Ordnertiefe
            rs.AddNew
            rs("Datei") = cLFs.Col_File(i)
            rs("Dateigrösse") = FileLen(cLFs.Col_File(i))
            rs("Dateidatum") = FileDateTime(cLFs.Col_File(i))
            tSplitPath = fileSplit(cLFs.Col_File(i))
            rs("Pathname") = tSplitPath.sDrive & tSplitPath.sPath
            rs("Filename") = tSplitPath.sFile
            rs.Update
            DoEvents
        Else
            '*******************************************
            'Prüfen der erreichten Ordnertiefe
            sTemp = Mid(cLFs.Col_File(i), iLen + 1)
            iCountSign = CountSign(sTemp, "\")
            '*******************************************
            If iCountSign <= iDepth Then
            'Vergleich Soll und IST Ordertiefe
                rs.AddNew
                rs("Datei") = cLFs.Col_File(i)
                rs("Dateigrösse") = FileLen(cLFs.Col_File(i))
                rs("Dateidatum") = FileDateTime(cLFs.Col_File(i))
                tSplitPath = fileSplit(cLFs.Col_File(i))
                rs("Pathname") = tSplitPath.sDrive & tSplitPath.sPath
                rs("Filename") = tSplitPath.sFile
                rs.Update
                'Anzahl der Dateien
                nCount = nCount + 1
                DoEvents
            End If
        End If
    Next i

    ' Anzahl der gefunden Dateien anzeigen
    If iDepth <> 0 Then Me.lbl_CountFiles.Caption = nCount & " Dateien nach den Kriterien gefunden"
    DoCmd.Echo True
    rs.Close
    db.Close
    
    On Error GoTo 0
    Exit Sub

Folder_Error:
    Resume Next
End Sub
 
Call ReadFolder("E:\Eigene Dateien\Access", "*.mdb", True, 2)
 
Hier würden alle MDB-Dateien aus dem Verzeichnis "E:\Eigene Dateien\Access" mit Unterverzeichnissen bis 2 Ebenen unter dem Startverzeichnis eingelesen.

Dateien:

Nur für 32Bit Office Versionen

Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank

ab A00

Die RAR-Datei enthält eine Version ab A00
Datum 05.02.2018
Dateigröße 23.68 KB
Download 1.537

 

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png5.png7.png8.png9.png5.png1.png
Heute469
Gestern271
Diese Woche1300
Dieser Monat7574
Total1578951

  • IP: 3.238.62.119
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

3
Online

28. März 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...